Copier les lignes selon une valeur

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

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

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