Copie de plusieurs feuilles dans nouveau classeur

Bonjour au forum,

J'essaie d'écrire un code me permettant de copier toutes les feuilles commençant par "Semaine" de mon classeur vers un autre classeur.

J'ai testé plusieurs codes mais j'ai dû mal à parvenir à un bon résultat...

Ci-dessous le dernier code testé et qui évidemment ne fonctionne pas...

Option Explicit
Dim Chemin$, Fichier$, TDest$, Ws As Worksheet, Cible As Workbook

Sub Copy()

Application.DefaultSaveFormat = xlOpenXMLWorkbook
Application.DisplayAlerts = False

Set Cible = Application.Workbooks.Add

Chemin = "O:\BlaBla\"
Fichier = "Fichier_Copy.xlsx"
TDest = Chemin & Fichier

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "Semaine*" Then
        Ws.Copy Before:=Cible.Worksheets
    End If
Next Ws

Cible.SaveAs TDest, xlOpenXMLWorkbook

End Sub

Quelqu'un aurait la gentillesse de m'aider ?

Merci d'avance !

En creusant un peu plus j'ai pû trouver la solution...

Pour ceux que ça intéresse :

Option Explicit
Dim Chemin$, Fichier$, TDest$, Ws As Worksheet, Cible As Workbook, i As Byte

Sub Copy()

Application.DefaultSaveFormat = xlOpenXMLWorkbook
Application.DisplayAlerts = False

Set Cible = Application.Workbooks.Add

Chemin = "Blabla"
Fichier = "Fichier_Copy.xlsx"
TDest = Chemin & Fichier

With ThisWorkbook
    For i = 1 To .Sheets.Count
        If .Sheets(i).Name Like "Semaine*" Then
       .Sheets(i).Copy after:=Cible.Worksheets(Cible.Worksheets.Count)
        End If
    Next i
End With

Cible.SaveAs TDest, xlOpenXMLWorkbook

End Sub

Rechercher des sujets similaires à "copie feuilles nouveau classeur"