Option Explicit
Sub test()
Dim Collect As New Collection, Derlig As Long, CL1 As Workbook
Dim FL1 As Worksheet, NomClassseur As String, DerLigBanque As Long
Dim Chemin As String, NomFich As String, NoLig As Long, i As Integer
'Evite les mouvements de feuilles
Application.ScreenUpdating = False
'****** Evite les demandes de confirmation d'Excel
Application.DisplayAlerts = False
Chemin = "D:\xls\Banques\" '******** Pense à modifier ***********
NomClassseur = ThisWorkbook.Name 'le classeur contenant la macro ("Fichier central")
'Création des instances (pour plus de facilité de lecture)
Set CL1 = Workbooks(NomClassseur)
Set FL1 = CL1.Worksheets("feuil1")
Derlig = Split(FL1.UsedRange.Address, "$")(4)
For NoLig = 2 To Derlig
On Error Resume Next
'Création de la collection contenant la liste des banques sans doublon
If FL1.Cells(NoLig, 1) <> "" Then Collect.Add FL1.Cells(NoLig, 1).Value, FL1.Cells(NoLig, 1).Value
'création des classeurs correspondants
'MsgBox Err.Number
If Err.Number = 0 Then '(erreur si doublon)
'******* Création d'une copie de la feuille principale contenant l'entête
FL1.Copy After:=CL1.Worksheets(CL1.Worksheets.Count)
'******* Suppression des données dans la copie à partir de la ligne 2
CL1.Worksheets(CL1.Worksheets.Count).Range("A2:" & _
Split(ActiveSheet.UsedRange.Address, ":")(1)).Delete
'******* Déplacement de la copie dans un nouveau classeur
CL1.Worksheets(CL1.Worksheets.Count).Move
'donne au système le temps de créer un nouveau fichier
DoEvents
'******* Renomme la feuille copiée
ActiveSheet.Name = "Feuil1"
ActiveWorkbook.SaveAs Chemin & Collect(Collect.Count)
'donne au système le temps de sauvegarde le fichier créé
DoEvents
End If
On Error GoTo 0
Next
'Copie des données correspondant à chaque banque dans le classeur correspondant
For NoLig = 2 To Derlig
If FL1.Cells(NoLig, 1) = "" Then Exit For
NomFich = FL1.Cells(NoLig, 1) & ".xls"
DerLigBanque = Workbooks(NomFich).Worksheets("Feuil1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
FL1.Rows(NoLig).Copy Workbooks(FL1.Cells(NoLig, 1) & ".xls").Worksheets("feuil1").Cells(DerLigBanque + 1, 1)
Next
'Sauvegarde et fermeture du classeur de chaque banque & Effacement de la collection
For i = Collect.Count To 1 Step -1
NomFich = Collect(i) & ".xls"
'Sauvegarde et fermeture du classeur de chaque banque
Workbooks(NomFich).Close True
'donne au système le temps d'enregistrer et de fermer le fichier complété
DoEvents
'Effacement de la collection
Collect.Remove i
Next
'****** On se replace sur la cellule A1 de la feuil1 (à adapter) du classeur principal
FL1.Activate
FL1.Range("A1").Select
'suppression des instances
Set FL1 = Nothing
Set CL1 = Nothing
Application.ScreenUpdating = True
End Sub
