Créer un fichier par ligne

Option Explicit

Sub Export()
    Dim Cellule As Range
    Dim WkbSrc As Workbook, WkbDst As Workbook
    Dim ShtSrc As Worksheet, ShtDst As Worksheet
    
    Application.ScreenUpdating = False
        If Dir(ThisWorkbook.Path & "\listing.xlsx") = "" Then
            MsgBox "Le fichier 'listing' (listing.xlsx) est introuvable.", vbOKOnly
        Else
            If Dir(ThisWorkbook.Path & "\grille.xlsx") = "" Then
                MsgBox "Le fichier 'Modele' (grille.xlsx) est introuvable.", vbOKOnly
            Else
                Set WkbSrc = Workbooks.Open(Filename:=ThisWorkbook.Path & "\listing.xlsx")
                Set ShtSrc = WkbSrc.Sheets(1)
                
                For Each Cellule In ShtSrc.Range("N2:N" & ShtSrc.Range("N65536").End(xlUp).Row)
                    If Dir(ThisWorkbook.Path & "\" & Cellule.Value & ".xlsx") = "" Then
                        Set WkbDst = Workbooks.Open(Filename:=ThisWorkbook.Path & "\grille.xlsx")
                    Else
                        Set WkbDst = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & Cellule.Value & ".xlsx")
                    End If
                    
                    Set ShtDst = WkbDst.Worksheets("Grille")
                        
                    ShtDst.Range("C5").Value = ShtSrc.Range("L" & Cellule.Row).Value
                    ShtDst.Range("C7").Value = ShtSrc.Range("B" & Cellule.Row).Value
                    ShtDst.Range("C9").Value = ShtSrc.Range("J" & Cellule.Row).Value
                    ShtDst.Range("G5").Value = ShtSrc.Range("E" & Cellule.Row).Value
                    ShtDst.Range("G7").Value = ShtSrc.Range("F" & Cellule.Row).Value
                               
                    
                    If WkbDst.Name = "grille.xlsx" Then
                        WkbDst.Close savechanges:=True, Filename:=ThisWorkbook.Path & "\" & Cellule.Value & ".xlsx"
                    Else
                        WkbDst.Close savechanges:=True
                    End If
                Next Cellule
                
                WkbSrc.Close savechanges:=False
                
                Set ShtSrc = Nothing
                Set WkbSrc = Nothing
                Set ShtDst = Nothing
                Set WkbDst = Nothing
            End If
        End If
    Application.ScreenUpdating = True
End Sub