Copier une feuille vers un nouveau classeur

Bonjour à tous,

Je débute en VBA et en allant sur différent forums j'ai réussi à faire une partie de ma macro, mais je bloque sur la fin....

Je souhaiterais créer un fichier Excel, à partir d'un modèle, pour chaque adresse

A l'aide d'un fichier qui contient différentes données (secteurs, adresses et nb de logement), je souhaite créer un fichier pour chaque adresse à partir d'un modèle.

J'ai déjà réussi à créer un dossier par secteur qui contient un fichier Excel par adresse. Je bloque au moment de copier le modèle dans le nouveau classeur.

Pour que ce soit plus clair, je vous joint mon fichier...

Est-ce que quelqu'un aurait une idée de comment faire ? Je pense que pour vous ça doit être tout simple !

Je vous remercie d'avance !

Bonjour

ci joint une macro qui fait ce qui est demandé

Fred

Sub Test()
Dim objFso As Object, objFil As Object
Dim LastLig As Long, r As Long
Dim vDirectory As String, Chemin As String
Dim c As Range

'Chemin = "D:\GEOMATIQUE\Test_formulaire\"
Chemin = ThisWorkbook.Path & "\"
Application.ScreenUpdating = fale

Set objFso = CreateObject("Scripting.FileSystemObject")

With Worksheets("Test")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For r = 2 To LastLig
        vDirectory = .Cells(r, 1).Value
        If vDirectory <> "" And .Cells(r, 2).Value <> "" Then
            If Not objFso.FolderExists(Chemin & vDirectory) Then objFso.CreateFolder Chemin & vDirectory
            Sheets("Modele").Copy
            ActiveWorkbook.SaveAs Chemin & vDirectory & "\" & .Cells(r, 2).Value & ".xls", FileFormat:=56
            ActiveWorkbook.Close False

'            Set objFil = objFso.CreateTextFile(Chemin & vDirectory & "\" & .Cells(r, 2).Value & ".xls", True)
'            objFil.Close
'            Set objFil = Nothing
        End If
    Next r
End With
Set objFso = Nothing
End Sub