Sélection d'une ligne + copie sur nouveau fichier
Bonjour,
Nouveau sur le forum et débutant en excel ,
J'ai un tableau qui comporte une colonne "Name" ( colonne A) dans laquelle se trouve le nom des personnes, et plusieurs autres colonnes jusqu'à "CI" comportant des infos.
Je suis amené a faire une macro qui permet d'après mon tableau de sélectionner pour chaque personne de la colonne "Name" seulement sa première ligne lui correspondant (une personne peut avoir plusieurs ligne) et de copier cette ligne dans un nouveau fichier.
(ps: Les noms sont déjà trier par ordre alphabétique.)
Comment traduire cette idée en macro svp?
Cordialement,
Voici un exemple qui illustre mon tableau:
NAME---------------INFOS
Sami,B-------------projet 1
Sami,B-------------projet 1
Sami,B-------------projet 3
Jean,C-------------projet 1
Jean,C-------------projet 2
James,A-----------projet 1
Le but est de sélectionner pr chaque personne sa première ligne uniquement, et de le copier sur un nouveau fichier "out" par exemple.
Les fichiers sur lequel je vais exécuter la macro que j'essaye de réaliser seront toujours du même type et les noms seront toujours différents.
Voila une macro qui devrait fonctionner.
J'ai appelé data l'onglet dans lequel tu as toutes tes données de bases(les noms et toutes les infos...)
Et j'ai appelé Out l'onglet dans lequel tu copie la première ligne pour chaque nom.
Dans la boucle allant de 1 a 60, j'ai mis 60 car tu disait avoir des infos jusqu'à la colonne CI il me semble, donc à changer en fonction du numéro de la dernière colonne que tu veux copier.
Sub copy()
Dim nbcells, ligne, j, i As Integer
nbcells = Sheets("data").Range("A1").End(xlDown).Row
If Sheets("Out").Range("A2") = "" Then
ligne = 2
Else
ligne = 1 + Sheets("Out").Range("A2").End(xlDown).Row
End If
For i = 2 To nbcells
If Cells(i, 1) <> Cells(i - 1, 1) Then
For j = 1 To 60
Sheets("Out").Cells(ligne, j) = Sheets("data").Cells(i, j)
Next j
ligne = ligne + 1
End If
Next i
End Sub
Cette macro va copier les infos les unes à la suites des autres, et si tu exécute deux fois la macros, cela va te générer des doublons.
Pour ne pas générer de doublon et donc ne pas conserver d'historique, il suffit de remplacer
If Sheets("Out").Range("A2") = "" Then
ligne = 2
Else
ligne = 1 + Sheets("Out").Range("A2").End(xlDown).Row
End If
Par
ligne = 2
Ainsi, il commencera à copier les donnée à chaque fois au niveau de la ligne 2 de l'onglet Out.
Oui merciii sa donne un résultat correct,
Il y a juste un soucis sur les données qui correspondent à des dates car elles ne sont pas transmit sous le même format...
Sinon, comment peut-on faire pour:
- que le code crée lui même le fichier "Out"
- garder la mise en page du premier fichier sur le deuxième?
Cdt.
Bonjour,
En faite, j'ai trouvé une autre idée qui pourra aussi me servir et qui est peut-être plus simple.
Mon but cette fois-si est de rester sur le fichier (onglet) de base, pour cela:
- j'aimerais garder la première ligne pour chaque personne du tableau --> (l'idée de base)
- et effacer les suivantes dans le cas ou la personne à plus d'une ligne qui lui correspond
(ps: mon tableau commence à la colonne"A", ligne "9" => "A9", la derniere colonne est la 79ème)
Alors, pour créer un nouvel onglet et l'appeler Out, tu rajoute ça au début de ta Macro
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Out"
Sinon si tu veux supprimer les lignes directement sur la feuille tu fais comme ça
Sub suppr()
nbcells = Sheets("data").Range("A1").End(xlDown).Row
For i = 2 To nbcells
If Sheets("Out1").Cells(i, 1) <> "" And Sheets("data").Cells(i, 1) = Sheets("data").Cells(i - 1, 1) Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next i
End Sub
Attention, si tu fais ça, tes données sont supprimées définitivement.
Malheureusement je n'arrive pas à faire fonctionner cette dernière.
L'idée cette fois est de supprimer directement sur le fichier source, et donc de ne pas faire intervenir un deuxième fichier "Out"
autant pour moi
j'avais oublié une modif
Sub suppr()
nbcells = Sheets("data").Range("A1").End(xlDown).Row
For i = 2 To nbcells
If Sheets("data").Cells(i, 1) <> "" And Sheets("data").Cells(i, 1) = Sheets("data").Cells(i - 1, 1) Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next i
End Sub
Merci beaucoup,
J'ai testé sa fonctionne très bien.
J'aimerais poser une dernière question... Est-ce possible de regrouper deux macro en une?
En effet, j'aimerais rajouter une macro que j'ai enregistré à celle que vous m'aviez passé.
Voici la macro que je veux rajouter (elle trie le tableau en fonction d'une colonne date que je met du plus récent au plus ancien ensuite j’effectue un deuxième trie qui me permet de reclasser le tableau en fonction des noms(par ordre alphabétique)):
Sub trie()
ActiveCell.Offset(-40, 32).Range("A1").Select
ActiveCell.Offset(-1, 0).Range("A1:CI20").Sort Key1:=ActiveCell.Offset(-1, 35). _
Range("A1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
ActiveCell.Offset(0, -35).Range("A1").Select
ActiveCell.Offset(-1, 0).Range("A1:CI20").Sort Key1:=ActiveCell.Offset(-1, 0). _
Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
Il est tout à fait possible de mettre réunir les deux macro en une, il suffit de ne mettre les code l'un à la suite de l'autre, dans une seule sub.
Sub tri_suppr()
ActiveCell.Offset(-40, 32).Range("A1").Select
ActiveCell.Offset(-1, 0).Range("A1:CI20").Sort Key1:=ActiveCell.Offset(-1, 35). _
Range("A1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
ActiveCell.Offset(0, -35).Range("A1").Select
ActiveCell.Offset(-1, 0).Range("A1:CI20").Sort Key1:=ActiveCell.Offset(-1, 0). _
Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
nbcells = Sheets("data").Range("A1").End(xlDown).Row
For i = 2 To nbcells
If Sheets("data").Cells(i, 1) <> "" And Sheets("data").Cells(i, 1) = Sheets("data").Cells(i - 1, 1) Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next i
End sub
Cela étant dit, tu as du utiliser l'enregistreur de macro pour faire ton tri, et pendant ton enregistrement, tu t'es déplacé sur ton classeur pour aller chercher ta deuxieme colonne
les lignes suivante servent simplement à te déplacer sur la feuille, donc elle ne servent à rien et vont prendre du temps.
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
Tu peux donc à priori les supprimer sans que cela n'impacte le résultat
d'autre part, tu as enregistré ta macro en utilisant des référence relative ce qui signifie que l'adresse de la cellule sélectionnée avant de lancer la macro est va avoir un impact dans l'exécution de la macro. alors que j'ai développer la mienne en référence absolue l'adresse de la cellule ne compte pas.
Donc à mois que ton tableau ne soient amené à bouger dans l'avenir, je te conseil d'enregistrer à nouveau ta macro sans les références relatives.
Autrement, tu mes les deux codes l'un à la suite de l'autre comme je l'ai fait plus haut, et tout devrait fonctionner.