Sub Macro1()
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim c As String 'déclare la variable c (Chemin d'accès)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim temp As Variant 'déclare la variable temps (tableau TEMPoraire)
Dim x As Integer 'déclare la variable x (incrément)
Dim cd As Workbook 'déclare la variable cd (Classeur Destination)
Dim od As Object 'déclare la variable od (Onglet Destination)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim col As Integer 'décalre la variable col (COLonne)
Set cs = ThisWorkbook 'définit le classeur source
c = cs.Path & "\" 'définit la chemin d'accès
Set os = cs.Sheets("Pilots contacts") 'définit l'onglet source
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet source
col = os.Cells(8, Application.Columns.Count).End(xlToLeft).Column 'définit la colonne col
Set pl = os.Range("A9:A" & dl) 'définit la plage pl
Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
For Each cel In pl 'boucle sur toutes les celllules cel de la plage pl
dico(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnaire sans doublons
For x = 0 To UBound(temp) 'boucle sur tous les noms uniques temp(x) de la plage pl
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Workbooks.Open (c & temp(x) & ".xls") 'ouvre le classeur du nom (génère une erreur si le classeur n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err = 0 'annule l'erreur
Workbooks.Add 'ajoute un nouveau classeur
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreur
Set cd = ActiveWorkbook 'définit le classeur destination
Set od = cd.Sheets(1) 'définit l'onglet de destination
os.Range("A1:D8").Copy 'copie la plage A1:A8 de l'onglet source
od.Range("A1").PasteSpecial (xlPasteColumnWidths) 'collage spécial "largeur des colonnes" dans A1 de l'onglet destination
os.Range("A1:D8").Copy od.Range("A1") 'colle la plage dans A1
od.Range("A1").Select 'sélectionne A1
os.Range("A8").AutoFilter field:=1, Criteria1:=temp(x) 'filtre la plage pl par rapport au nom unique temp(x)
Set dest = IIf(od.Range("A9").Value = "", od.Range("A9"), od.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination dest
pl.SpecialCells(xlCellTypeVisible).Resize(pl.SpecialCells(xlCellTypeVisible).Rows.Count, col).Copy dest 'copie la plage pl, redimentionnée à la colonne D, et la colle dans dest
Application.DisplayAlerts = False 'empêche les message Excel
cd.SaveAs (c & temp(x) & ".xls") 'enregsitre le fichier sous...
cd.Close 'ferme le classerur destination
Application.DisplayAlerts = True 'affiche les messages Excel
Next x 'prochain nom unique de la boucle
os.Range("A8").AutoFilter 'affiche toutes les ligne de la plage pl
End Sub
