Copier les lignes selon une valeur
JBABIN
-
Jbabin -
Jbabin -
Bonjour,
J'ai un fichier contenant un tableau ou on retrouve toutes les transactions pour chaque nom de conseiller. Je veux créer une macro qui créera un nouveau fichier pour chaque conseiller (avec le nom du conseiller) et coller toutes les lignes associés à ce conseiller dans le fichier. Les noms se trouve dans la colonne D.
Merci
J'ai un fichier contenant un tableau ou on retrouve toutes les transactions pour chaque nom de conseiller. Je veux créer une macro qui créera un nouveau fichier pour chaque conseiller (avec le nom du conseiller) et coller toutes les lignes associés à ce conseiller dans le fichier. Les noms se trouve dans la colonne D.
Merci
A voir également:
- Copier les lignes selon une valeur
- Comment copier une vidéo youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Historique copier coller - Guide
- Excel trier par ordre alphabétique en gardant les lignes - Guide
- Afficher toutes les lignes masquées excel ✓ - Forum Excel
2 réponses
bonjour,
voici le fichier avec la macro :
https://www.cjoint.com/c/FDqhm4rcAj0
voici la macro :
Sub conseiller()
lignesource = 2
'on nomme la variable source pour le classeur d'origine
Source = ActiveWorkbook.Name
'on prend le nom du collaborateur en ligne i et en colonne 4
Do While Sheets("sheet1").Cells(lignesource, 4) <> ""
'on enregistre le nom du collaborateur dans la variable name
Name = Sheets("sheet1").Cells(lignesource, 4)
'on vérifie que le collaborateur n'a pas déjà été traité
If Cells(lignesource, 100) = "" Then
'on ajoute 1 classeur, on l'enregistre sous le nom du collaborateur, on copie la ligne d'entête située en 1ère ligne
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Workbooks(Source).Path & "\" & Name & ".xlsx"
Workbooks(Source).Activate
Rows(1).Copy
Workbooks(Name).Activate
Cells(1, 1).Select
ActiveSheet.Paste
lignenom = lignesource
lignedest = 2
'on va balayer le classeur source pour trouver toutes les lignes correspondant au collaborateur
Workbooks(Source).Activate
Do While Sheets("sheet1").Cells(lignenom, 4) <> ""
'si le nom = nom du classeur alors
If Sheets("sheet1").Cells(lignenom, 4) = Name Then
'on va copier la ligne collabo dans son classeur
Rows(lignenom).Copy
Workbooks(Name).Activate
Cells(lignedest, 1).Select
ActiveSheet.Paste
Workbooks(Name).Activate
Workbooks(Source).Activate
'un indicateur permettant d'indiquer les lignes traitées
Sheets("sheet1").Cells(lignenom, 100) = "X"
lignedest = lignedest + 1
End If
lignenom = lignenom + 1
Loop
'on sauve et ferme le classeur collabo
Workbooks(Name).Save
Workbooks(Name).Close
End If
lignesource = lignesource + 1
Loop
Workbooks(Source).Activate
Columns(100).Clear
End Sub
voici le fichier avec la macro :
https://www.cjoint.com/c/FDqhm4rcAj0
voici la macro :
Sub conseiller()
lignesource = 2
'on nomme la variable source pour le classeur d'origine
Source = ActiveWorkbook.Name
'on prend le nom du collaborateur en ligne i et en colonne 4
Do While Sheets("sheet1").Cells(lignesource, 4) <> ""
'on enregistre le nom du collaborateur dans la variable name
Name = Sheets("sheet1").Cells(lignesource, 4)
'on vérifie que le collaborateur n'a pas déjà été traité
If Cells(lignesource, 100) = "" Then
'on ajoute 1 classeur, on l'enregistre sous le nom du collaborateur, on copie la ligne d'entête située en 1ère ligne
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Workbooks(Source).Path & "\" & Name & ".xlsx"
Workbooks(Source).Activate
Rows(1).Copy
Workbooks(Name).Activate
Cells(1, 1).Select
ActiveSheet.Paste
lignenom = lignesource
lignedest = 2
'on va balayer le classeur source pour trouver toutes les lignes correspondant au collaborateur
Workbooks(Source).Activate
Do While Sheets("sheet1").Cells(lignenom, 4) <> ""
'si le nom = nom du classeur alors
If Sheets("sheet1").Cells(lignenom, 4) = Name Then
'on va copier la ligne collabo dans son classeur
Rows(lignenom).Copy
Workbooks(Name).Activate
Cells(lignedest, 1).Select
ActiveSheet.Paste
Workbooks(Name).Activate
Workbooks(Source).Activate
'un indicateur permettant d'indiquer les lignes traitées
Sheets("sheet1").Cells(lignenom, 100) = "X"
lignedest = lignedest + 1
End If
lignenom = lignenom + 1
Loop
'on sauve et ferme le classeur collabo
Workbooks(Name).Save
Workbooks(Name).Close
End If
lignesource = lignesource + 1
Loop
Workbooks(Source).Activate
Columns(100).Clear
End Sub
Bonjour Jbabin et le forum,
Il serait intéressant que l'on puisse la structure du tableau source et nous préciser le nombre de lignes (environ) de ton tableau
pour cela
Dans l’attente
Il serait intéressant que l'on puisse la structure du tableau source et nous préciser le nombre de lignes (environ) de ton tableau
pour cela
Mettre le classeur sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci par un clic droit sur le lien proposé dans le message de réponse
Dans l’attente
avec 2-3 ajustement, la macro a fonctionné!!
Merci beaucoup Melanie