Copier des données Excel dans des autres fichiers

Bonjour,

ce code me permet de découper un fichier dans des autres fichiers

excel selon la colonne T (filter ):

Option Explicit

Sub creation_fichiers()
Dim i As Integer
Dim sh, Dlg, plg
Dim Nomfich$
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sh = Sheets(1)
Dlg = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set plg = sh.Range("A5:T" & Dlg)
sh.Range("T6:T" & Dlg).Copy sh.[AA1]
sh.Columns("AA").RemoveDuplicates Columns:=Array(1), Header:=xlYes
sh.[AB1] = sh.[T5]

For i = 2 To sh.Cells(Rows.Count, "AA").End(xlUp).Row
Workbooks.Add
sh.[AB2] = sh.Range("AA" & i)

plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh.Range("AB1:AB2"), CopyToRange:=ActiveWorkbook.Sheets(1).Range("A5:T5")
Nomfich = (sh.Range("AA" & i)) & ("- Actings, Assignments") & ".xls"
Nomfich = Replace(Nomfich, "/", "")

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Nomfich, FileFormat:=xlExcel8

Worksheets("Sheet1").Range("A1:H1").Copy _
Destination:=Worksheets("Sheet1").Range("A1")

ActiveWorkbook.Close False
Next i
sh.[AA:AC].ClearContents

MsgBox (" Vos fichiers ont été bien traités avec succès ")
End Sub

j'aimerai bien aussi copier des données qui se sont situés au ["A1:H1"] dans le fichier principal et les transferer dans chanque nouvelle copier vers un nouveau fichier créee , j'ai ajouté ces deux lignes a la fin mais ca me donne rien

Worksheets("Sheet1").Range("A1:H1").Copy _
Destination:=Worksheets("Sheet1").Range("A1")