copier/coller d edonner sur criteres par macro

[domflo]

Bonjour,

En visitant le forum j'ai presque trouvé la macro qu'il me fallait, mais il me manque une variable.
Cad j'ai une feuille avec des données et je souhaite copier toutes les lignes qui ont la même valeur de A2 à A......, et copié ces lignes dans des classeurs que la macro ouvre.
Car la macro ci-dessous ne copie que la première ligne.
Mes connaissances en VBA sont quasi nulles, si vous pouviez m'aider
Par avance merci.
Voici la macro
+ le fichier joint
Sub test()
'

chemin = ActiveWorkbook.Path
MonNom = ActiveWorkbook.Name
For n = 2 To Range("A65536").End(xlUp).Row
Workbooks.Add(xlWBATWorksheet).SaveAs chemin & "/" & Workbooks(MonNom).Sheets("recap").Range("A" & n)
Workbooks(MonNom).Sheets("recap").Range("A1:l1").C opy Destination:=ActiveSheet.Range("A1")
Workbooks(MonNom).Sheets("recap").Range("A" & n & ":G" & n).Copy Destination:=ActiveSheet.Range("A2")
Next n
End Sub

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

Sub CreeClasseurs()
chemin = ActiveWorkbook.Path & "\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets.Add.Name = "transfert"
Sheets("recap").Select
Range("A4:A" & Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"K1"), Unique:=True
Range("J1").Value = "DR"
For Each c In Range("K2", Range("K65000").End(xlUp))
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Range("J2") = c
Sheets("transfert").Select
Sheets("recap").Range("A4:G10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("recap").Range("J1:J2"), CopyToRange:=Sheets("transfert").Range("A1:G1"), Unique:=False
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=chemin & c
ActiveWorkbook.Close
Sheets("recap").Select
Next c
Columns("J:K").Delete Shift:=xlToLeft
Range("A1").Select
Sheets("transfert").Select
ActiveWindow.SelectedSheets.Delete
End Sub

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

Voici ce que j'ai maintenant en J et K mais pas de nouvelles feuilles

J K
DR 13
16 14
16

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

Honnêtement, là, je comprends pas...
que tu aies des données en J3 n'est pas normal
que les données dans la colonne K ne soient pas égales aux valeurs uniques comprises dans la colonne A n'est pas normal...
Je réitère donc ma demande :
Peux-tu me mailer ou poster ici un fichier où tu as copié intégralement la colonne A?
Tu sélectionnes la colonne A, tu copies, tu crées un nouveau fichier et tu colles
A+

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

En J1 => DR
En j2 => 16

K1 => 13
K2 => 14
k3 => 16

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

Non non, le copier /coller a été modifier dans mon post, je n'ai rien en J3.
En k les valeurs sont bien uniques

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

OK,
DR est dans quelle cellule?
A4 ou A3 ou....?

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

DR est mon en tête en A1,

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

Yes, modifie :

Sheets("recap").Select
Range("A4:A" & Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"K1"), Unique:=True

par :

Sheets("recap").Select
Range("A1:A" & Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"K1"), Unique:=True

et dis-moi ce qu'il y a dans la colonne K (en K1 tu dois avoir DR)

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

En effet, j'ai bien DR en K1 ainsi qu'en j1

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

En effet, j'ai bien DR en K1 ainsi qu'en j1

Et???
ça fonctionne?

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

Au fait, tu en as profité pour modifier :

Sheets("transfert").Select
Sheets("recap").Range("A4:G10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("recap").Range("J1:J2"), CopyToRange:=Sheets("transfert").Range("A1:G1"), Unique:=False
ActiveSheet.Copy

par :

Sheets("transfert").Select
Sheets("recap").Range("A1:G10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("recap").Range("J1:J2"), CopyToRange:=Sheets("transfert").Range("A1:G1"), Unique:=False
ActiveSheet.Copy

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

Ben...non, il ne m'ouvre pas les classeurs 13/14/16 avec les lignes correspondantes.

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

oui, vu pour la modif de A4 en A1, mais il doit m'ouvrir un onglet 'transfert" ?

 

[Cousinhub]

Re : copier/coller d edonner sur criteres par macro

Euh, qu'on soit d'accord...

je souhaite copier toutes les lignes

non, il ne m'ouvre pas les classeurs 13/14/16 avec les lignes correspondantes

Tu veux ouvrir ou créer????????

As-tu regardé dans le répertoire si les fichiers existent (13,14,15.xls)

 

[domflo]

Re : copier/coller d edonner sur criteres par macro

ok, ca marche.
Je pensais qu'il allait m'ouvrir les classeurs nommés 13/14/16.

C'est parfait.
Encore un grand merci pour ton aide.