Discussion :

[R4944]

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

sh.Range("T6:T" & Dlg).Copy sh.[AA1]

mais sans résultats ;/

[Philippe Tulliez]

Bonjour,
Si j'ai bien compris à la lecture de ton code, tu souhaites copier sur des classeurs différents les données filtrées en fonction de données se trouvant dans une colonne. Autrement dit, tu splittes tes données.
Si c'est le cas, voir ce fil http://www.developpez.net/forums/d12...l/#post7190633 où tu trouveras l'explication et un classeur exemple à télécharger.

[R4944]

Ouii , mon code fonctionne trés bien , mais y'en a juste quelque données qui sont sur [A1:H1] que j'essaye de trouver une solution pour les copier aussi avec les données traités

[Philippe Tulliez]

Bonjour,
C'est normal que cette ligne

Code :

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

sh.Range("T6:T" & Dlg).Copy sh.[AA1]

ne fonctionne pas comme tu le souhaites car tu copies T6:Tx vers la cellule AA1 de la même feuille.

Or d'après ce que tu écris, tu veux copier A1:H1 de la feuille source vers une feuille cible se trouvant dans un classeur nouvellement créé).
A titre d'information, la méthode AdvancedFilter peut également copier une colonne sans les doublons (en remplacement de la méthode RemoveDuplicates)

[R4944]

oui mais le tableau que je traite c'est de [A5:T] c'est juste les données qui se trouvent dans [A1:H1] que je veux les transférer dans chaque création d'un nouveau fichier

[Philippe Tulliez]

Bonjour,
Oui, j'ai bien compris.
Il faut donc faire un simple Range.Copy Destination où Range est la plage source et Destination, la cellule cible (classeur nouvellement créé).

[R4944]

Voila ce que j'ai fait

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
38
39
40
41
42
43
44
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'ai ajouté ces deux lignes

Code :

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

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

ainsi que j'ai modifié l'emplacement de la copie ,la ça commence à partir de "A5"

ça me donne toujours la même chose sauf que les données se transfèrent à partir de la ligne 5

[Philippe Tulliez]

Bonjour,
Une cellule fait partie d'une feuille qui elle même fait partie d'un classeur or dans ta ligne de code tu ne références que les feuilles donc la copie se fera dans la feuille nommée Sheet1 du classeur actif.
En VBA, il faut toujours faire référence à la filiation complète des objets (ici objet Range)

En ligne 13 de ta procédure

Il faut modifier

Code :

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

Set sh = Sheets(1)

par

Code :

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

Set sh = ThisWorkbook.Sheets(1)

mais il serait préférable de donner le nom de la feuille car s'il y a déplacement de la feuille par un utilisateur la 1 deviendra peut-être la 2 ou une autre.
ThisWorkbook est le classeur où se trouve le code VBA

Code :

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

Set sh = ThisWorkbook.Sheets("Sheet1")

et la copie

Code :

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

sh.Range("A1:H1").Copy ActiveWorkbook.Sheets(1).Range("A1")

Attention j'ai écris ces lignes de mémoire et donc non testé

[R4944]

Re , merci pout ton initiave je viens de l'essayer c'est toujours la meme chose ça copie juste les données du tableau

[Philippe Tulliez]

Bonjour,

Re , merci pout ton initiave je viens de l'essayer c'est toujours la meme chose ça copie juste les données du tableau

Pourrais-tu publier toute ta procédure avec les modifications apportées ?