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 ):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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("A1: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("A1:T")
Nomfich = (sh.Range("AA" & i)) & ("- Actings, Assignments") & ".xls"
Nomfich = Replace(Nomfich, "/", "")
 
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Nomfich, FileFormat:=xlExcel8
 
 
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 tous les fichiers au moment de la copie , j'ai essayé de modifier cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part