Copier ligne sans écraser les déjà existante

Fermé

Tranquillou - 16 déc. 2008 à 10:53
Tranquillou - 17 déc. 2008 à 15:09

Bonjour,

Je cherche à copier des lignes d'un onglet vers un autre sans écraser les données existantes.

Ma prog fonctionne très bien mais que pour une seule ligne à copier.
Dès que j'ai plus d'une ligne à copier, celles-ci se copient bien sur la première ligne vide mais en copiant toutes mes lignes sur une seule. Donc je ne vois que la dernière ligne à copier.

ub Macro2()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Dim r As Long

Sheets("Archivage").Activate

Col = "K"
r = Range("A65536").End(xlUp).Row + 1
NumLig = 1
With Sheets("Liste SR")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value = "O" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(r, 1).Select
ActiveSheet.Paste
End If
Next
End With

Sheets("Liste SR").Activate

Dim K As Long
Dim Plage As Range
Set Plage = Range("K:K")
For K = Plage.Cells.Count To 1 Step -1
If Plage.Cells(K).Value = "O" Then
Plage.Cells(K).EntireRow.Delete
End If
Next
MsgBox ("ARCHIVAGE EFFECTUE")
End Sub

Merci pour votre aide

A voir également:

Copier ligne sans écraser les déjà existante
Copier une vidéo youtube - Guide
Hors ligne instagram - Guide
Aller à la ligne excel - Guide
Vente en ligne particulier - Guide
Super copier - Télécharger - Gestion de fichiers

13 réponses

Réponse 1 / 13

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
16 déc. 2008 à 11:50

Salut,

Testes cette macro, qui sur la feuille Liste SR lance une recherche de cellule valide à partir de la cellule A50, sélectionne la première cellule valide à la cellule U2 et met cette sélection en position copier
passe sur la feuille Archive recherche la première cellule valide et copie à la suite, revient feuille Liste SR et efface la sélection on pourrai mette un enregistrement pour finir.
On en reparle en debut d'après midi

Sub test()
Range("A50").Select
Do While ActiveCell.Value = ""
ActiveCell.Offset(-1, 0).Range("A1").Select
Loop
Range("U2", ActiveCell).Select
Selection.Copy
Sheets("Archivage").Activate
Range("A50").Select
Do While ActiveCell.Value = ""
ActiveCell.Offset(-1, 0).Range("A1").Select
Loop
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Sheets("Liste SR").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
End Sub

A+

Réponse 2 / 13

Tranquillou
16 déc. 2008 à 13:33

Tout d'abord merci. Moi qui pensait qu'il me manquait qu'une ou deux lignes de prog......
Je vois çà et je te tiens au courant dans la prochaine heure. Besoin du fichier ?

Réponse 3 / 13

Tranquillou
16 déc. 2008 à 14:33

J'ai testé mais cela ne correspond pas à mon besoin.

Le but étant de sélectionner dans "Liste SR" les lignes dont la colonne K est renseigné par un "O" (Cela fonctionne avec mon développement).

Ensuite les "couper/coller" dans l'onglet "Archive" les unes à la suite des autres sans écraser l'historique déjà "coller".

Et donc mon souci est que si dans "Liste SR" je n'ai qu'une seule ligne renseignée par un "O" cela fonctionne parfaitement avec mon développement. L'unique ligne se colle bien à la suite des précédentes.

Le souci viens lorsque j'ai plusieurs lignes renseignées par un "O".
Ex: J'ai 3 lignes renseignées par un "O". Et bien la première des lignes va bien se copier sous mes données déjà présentes, mais ma deuxième lignes "O" viens écraser cette première et la 3ème écrase la deuxième qui a écrasé la 1er.
Donc je ne vois que la dernière ligne qui elle-même s'est bien positionnée.

Est-ce clair ?

Réponse 4 / 13

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
16 déc. 2008 à 15:11

Salut,

J'ai bien compris ton problème, mon code doit parfaitement te convenir en l’adaptant. mais dans ta colonne K les cellules renseignées par un O sont elles contigües ou non

Le plus simple est que tu mettes à notre disposition un exemple de fichier sans notes confidentielles de façon à écrire un code adapté à ton problème
Avec ce lien

https://www.cjoint.com/

et sur ton prochain post donnes nous le lien généré pour que l’on puisse le récuper

A+

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 13

Tranquillou
16 déc. 2008 à 16:31

Ok merci mais par contre donne moi ton mail afin que je puisse t'envoyer ce fichier car il fait plus de 3Mo.
Merci encore.

Réponse 6 / 13

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
16 déc. 2008 à 17:34

même si ton fournisseur d'accès n'est pas free, fais ce qui suit et colle le lien généré dans un message privé en cliquant sur mon pseudo et message privé

Dans la barre URL tu saisis

https://portail.free.fr/

2/ En haut à droite cliquer sur envoi de gros fichiers
3 Fichier à envoyer faire parcourir et sélectionner le fichier à envoyer
4/ Me notifier du lien par email saisir son adresse mail afin que free te notifie du lien
5/ si tu veux protéger ton fichier saisie un mot de passe
6/ envoyer
Tu recevras de free un mail te donnant l’adresse pour récupérer ton envoi et éventuellement le supprimer après réception de l’envoi par tes correspondants.
Il ne suffit plus que d’envoyer a tes correspondants l’adresse du lien et le mot de passe pour y accéder si tu en a saisie un.
L’intérêt de cette méthode est de ne pas être obligé de réduite la taille d'un fichier ou la définition de photos par exemple et la démarche est anonyme

Réponse 7 / 13

Tranquillou Messages postés 1 Date d'inscription mardi 16 décembre 2008 Statut Membre Dernière intervention 16 décembre 2008
16 déc. 2008 à 19:26

Merci pour la procèdure.
Fait.
http://dl.free.fr/getfile.pl?file=/s3Dg6Qrr

Réponse 8 / 13

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
16 déc. 2008 à 23:36

.Salut,

Récupères le fichier avec le lien ci-dessous

http://dl.free.fr/getfile.pl?file=/A18xPgQP

Ne touche pas à la cellule K1 dans laquelle j'ai placé une formule pour gérer mon code.

Testes le fichier dans tous les sens et on en reparle, ma macro est nommée test

1/ la macro archives les lignes avec un O en colonne K et s'exécute autant de fois qu'elle rencontre des O
2/ aprés archivage elle supprime les lignes vides
3/ elle recrée les lignes supprimées jusqu'a la ligne 850 (à voir jusqu'ou tu souhaites aller)
4/ elle restaure les formules en colonne K et M des lignes remplacées

Il reste peut être à intégrer dans le code une protection avec mot de passe de la feuille Achives (à voir ainsi que du module macro)

lorsque nous aurons terminé, je te détaillerai chaque ligne du code

A+

Réponse 9 / 13

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
16 déc. 2008 à 23:38

Bonjour,
Tu a oublié... r=r+1
A+

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
16 déc. 2008 à 23:48

Salut lermite222,

comment va,

j'ai écrit le code test ()
rapidement, je regarderai demain mais à première vue je ne vois pas.

je dois pouvoir supprimer une ligne conditionnelle du code mais demain passera par là.

et on va attendre que Tranquillou récupère sont fichier sur le post 8
mais merci de suivre

A+

Réponse 10 / 13

Mike-31 Messages postés 18310 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 29 mars 2024 5 073
17 déc. 2008 à 09:23

Salut Tranquillou,

Tu peux télécharger mon exemple sur le post 8 pour voir comment fonctionnent les macros.
Mais ce matin j'ai un peu de temps, j'ai revu tout le code pour avoir le même résultat et plus rapide,

La macro se limite au code ci-dessous que tu peux tester en copiant dans le module, affecte le a un bouton et on en reparle en fin de matinée pour affiner tes besoins

Sub test2()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Dim r As Long
Sheets("Archivage").Activate
Col = "K"
r = Range("A65536").End(xlUp).Row + 1
NumLig = 1
With Sheets("Liste SR")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value = "O" Then
.Cells(Lig, Col).EntireRow.Cut

NumLig = NumLig + 1
Cells(r, 1).Select
r = r + 1
ActiveSheet.Paste
End If
Next
End With

Sheets("Liste SR").Activate
Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("A3:M3").Select
Selection.Copy
Range("A3:M850").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Range("K3:M3").Select
Selection.Copy
Range("K3:M850").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
MsgBox ("ARCHIVAGE EFFECTUE")
End Sub

Réponse 11 / 13

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
17 déc. 2008 à 13:09

Re bonjour à tous,
un petit "essais" plus cour ?

Sub Macro2()

Dim Lig As Long
Dim LigFinA As Long
Dim Col As Integer
Dim NbrLig As Long
Dim FL1 As Worksheet

    Set FL1 = Sheets("Archivage")
    Col = 11
    LigFinA = FL1.Range("A65536").End(xlUp).Row + 1
    With Sheets("Liste SR")
        NbrLig = .Cells(65536, Col).End(xlUp).Row
        For Lig = NbrLig To 1 Step -1
            If .Cells(Lig, Col).Value = "O" Then
                .Rows(Lig).Copy FL1.Rows(LigFinA)
                .Rows(Lig).Delete
                LigFinA = LigFinA + 1
            End If
        Next
    End With

    MsgBox ("ARCHIVAGE EFFECTUE")
End Sub

A+

Réponse 12 / 13

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
17 déc. 2008 à 13:19

Rectificatif, la macro précédante copie à "l'enver"

Sub Macro3()

Dim Lig As Long
Dim LigFinA As Long
Dim Col As Integer
Dim NbrLig As Long
Dim FL1 As Worksheet
Const PremLig = 3 'Première ligne à traiter
    Set FL1 = Sheets("Archivage")
    Col = 11
    LigFinA = FL1.Range("A65536").End(xlUp).Row + 1
    With Sheets("Liste SR")
        NbrLig = .Cells(65536, Col).End(xlUp).Row
        For Lig = PremLig To NbrLig
            If .Cells(Lig, Col).Value = "O" Then
                .Rows(Lig).Copy FL1.Rows(LigFinA)
                .Rows(Lig).Delete
                LigFinA = LigFinA + 1
                Lig = Lig - 1
            End If
        Next
    End With

    MsgBox ("ARCHIVAGE EFFECTUE")
End Sub

Celle-ci copie à "l'endroit" :-)
PS: Un petit conseil, essaye d'éviter des variables qui ne veulent rien dire, genre r, emploi plutôt des variables significatives ce sera beaucoups plus facile à suivre.
Pour exemple j'emploi Lig, Col, FinLig, FinCol etc..
Un autre ptit truc... Dans tes noms de variables tu met une ou deux majuscules mais quand tu l'écrit tu ne met pas de majuscule, le nom va se mettre à jour automatiquement, si pas, c'est qu'il y a une erreur dans le nom.

Réponse 13 / 13

Tranquillou
17 déc. 2008 à 15:09

Excusez-moi pour la réponse tardive...
Toutes vos réponses m'ont permis de comprendre là où mon cerveau s'est limité.
En tout cas merci beaucoup car vos codes fonctionnent parfaitement et correspondent parfaitement à mes besoins.

Dernière petites questions beaucoup moins technique.
Quel ouvrage puis-je acheter pour maitriser "la chose" Excel en général et VBA. Quel est votre conseil ?

Discussions similaires

Dessiner avec son clavier et avec des lettres

Que veut dire "correspondant occupé" lors d'un appel ?

Connaissez-vous un simulateur de coiffure gratuit ?

Statut « en ligne » alors que non

Discussions similaires

Newsletters