Déplacer plusieurs feuilles sélectionnées par

Bonjour,

J'aimerais déplacer plusieurs feuilles sélectionnées par macro dans un nouveau classeur mais la macro que j'ai écrite ne fonctionne pas.

Sub CreeFichier()
'
' Définition des variables utilisées

  Dim NbFeuilles, i As Integer
  Dim NomFichier As String
  Dim TableDesFeuilles() As String
  Dim S As Worksheet
  Dim X As Byte
  Dim WB1 As Workbook


' Début de la macro
  ' Je recherche le nombre totale du classeur
    NbFeuilles = Sheets.Count
    i = 0
  ' Défini le nom du nouveau fichier en fonction du camp
    NomFichier = Sheets("Données de base").Range("F25").Value
  ' Crée le fichier
    Workbooks.Add
  ' Sauve le classeur sous nouveau nom
    ActiveWorkbook.SaveAs Filename:=NomFichier
  '  MsgBox ("PretMateriel.xls"), vbOKOnly, "Nom du classeur"
    
    Workbooks("PretMateriel.xls").Activate

  ' Sélectionne toutes les feuilles à déplacer du fichier
    For i = 3 To NbFeuilles
    ReDim Preserve TableDesFeuilles(X)
    TableDesFeuilles(X) = Sheets(i).Name
        X = X + 1
    Next
    Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Select

' Les feuilles à déplacer sont bien sélectionnées
' et c'est là que le bas blesse ...
  
  ' Déplace toutes les feuilles dans le classeur créé
    Sheets(Array(TableDesFeuilles)).Move _
        Before:=Workbooks(NomFichier).Sheets(1)
'
' ou
'
    Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Move _
        Before:=Workbooks(NomFichier).Sheets(1)

' les deux solutions renvoient une erreur

La macro fonctionne jusqu'au 4 dernière ligne et après se plante sans que je ne comprenne pourquoi !

Merci de votre aide