Copier les lignes selon une valeur Fermé

Question

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

Configuration: Windows / Chrome 49.0.2623.112

melanie1324 · Answer

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

michel_m · Answer

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

Copier les lignes selon une valeur

2 réponses

Discussions similaires