Sub Arbo()
Dim LigneFin As Long, Tourne As Long, Ligne As Long
Dim Temoin As Boolean
Dim Chemin As String, Nom As String
Chemin = "c:\temp\"
With ThisWorkbook.Sheets("Feuil1")
LigneFin = .Range("B" & Rows.Count).End(xlUp).Row
For Tourne = 2 To LigneFin
If Temoin And .Range("A" & Tourne) <> "" Then Workbooks(Nom).Close True: Temoin = False
If .Range("A" & Tourne) <> "" Then
Nom = Range("A" & Tourne) & "_" & Range("B" & Tourne) & ".xlsx"
ChDir Chemin
MkDir Nom
Application.Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Chemin & Nom & "\" & Nom
Temoin = True
Ligne = 1
Else
Workbooks(Nom).Sheets("Feuil1").Range("A" & Ligne & ":C" & Ligne) = ThisWorkbook.Sheets("Feuil1").Range("B" & Tourne & ":d" & Tourne).Value
Ligne = Ligne + 1
End If
Next
End With
End Sub