Sujet Précédent Sujet Suivant

Maco pour filtrer plusieurs listes excel 2000

bobbob83 Messages postés 32 Date d'inscription vendredi 27 juillet 2007 Statut Membre Dernière intervention 22 novembre 2007 - 21 août 2007 à 14:10
bobbob83 Messages postés 32 Date d'inscription vendredi 27 juillet 2007 Statut Membre Dernière intervention 22 novembre 2007 - 23 août 2007 à 13:24
bonjour




j'ai fais une macro de tri automatique pour pouvoir trier plusieur listes car si je fais une seul liste le fichier est trop gros et j'ai un message "mémoire insufisante"




chaque liste est dans un fichier Liste 1.xls, Liste 2.xls Liste 3.xls .... et la feuille s'appelle Liste 1, Liste 2 , Liste 3 ...




le fichier recherches répertoire contien la zone de critaire et c la que je copie le résultat final de la recherche




la macro filtre les listes de chaque ficher et copie le resutat dans Le fichier Filtre1 , filtre 2, filtre 3 ....




puis colle le resultat dans un fichier general.xls




la liste générale et filter puis copié dans recherche répertoire




vu que j'ai 37 fichiers de liste cela prend beaucoup de temps j'e voudrais savoir si le code est bon




pourriez vous me dire si il y a des erreur de syntaxe svp merci




voila un extrait de la macro avec 5 fichiers liste




Sub Macro2()




' Macro2 Macro




' Macro enregistrée le 04/07/2007 par POSTE09




Sheets("Recherche répertoire").Select




Application.ScreenUpdating = False




'




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Generale.xls"




Sheets("Listegenerale").Select




Range("A15:I65526").Select




Selection.ClearContents




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste1.xls"




'










Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre1.xls"




Windows("Filtre1.xls").Activate




Workbooks("Liste1.xls").Sheets("Liste1").Range("B4:J65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _




Unique:=False




Windows("Liste1.xls").Activate




Workbooks("Liste1.xls").Close SaveChanges:=False




'




Windows("Filtre1.xls").Activate




'




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




Selection.Copy




Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre1.xls").Activate




Workbooks("Filtre1.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste2.xls"




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre2.xls"




'




Windows("Filtre2.xls").Activate




Workbooks("Liste2.xls").Sheets("Liste2").Range("B4:J65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _




Unique:=False




Windows("Liste2.xls").Activate




Workbooks("Liste2.xls").Close SaveChanges:=False




Windows("Filtre2.xls").Activate




'




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




Selection.Copy




Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre2.xls").Activate




Workbooks("Filtre2.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste3.xls"




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre3.xls"




'




Windows("Filtre3.xls").Activate




Workbooks("Liste3.xls").Sheets("Liste3").Range("B4:J65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _




Unique:=False




Windows("Liste3.xls").Activate




Workbooks("Liste3.xls").Close SaveChanges:=False






 



Windows("Filtre3.xls").Activate




'




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




Selection.Copy




Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre3.xls").Activate




Workbooks("Filtre3.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste4.xls"




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre4.xls"




'




Windows("Filtre4.xls").Activate




Workbooks("Liste4.xls").Sheets("Liste4").Range("B4:J65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _




Unique:=False




Windows("Liste4.xls").Activate




Workbooks("Liste4.xls").Close SaveChanges:=False




'




Windows("Filtre4.xls").Activate




'




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




Selection.Copy




Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre4.xls").Activate




Workbooks("Filtre4.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste5.xls"




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre5.xls"




'




Windows("Filtre5.xls").Activate




Workbooks("Liste5.xls").Sheets("Liste5").Range("B4:J65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _




Unique:=False




Windows("Liste5.xls").Activate




Workbooks("Liste5.xls").Close SaveChanges:=False




Windows("Filtre5.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




Selection.Copy




Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre5.xls").Activate




Workbooks("Filtre5.xls").Close SaveChanges:=False




Windows("Generale.xls").Activate




Range("a15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




With Selection




.HorizontalAlignment = xlCenter




.VerticalAlignment = xlCenter




.WrapText = True




.Orientation = 0




.AddIndent = False




.ShrinkToFit = False




.MergeCells = False




End With




With Selection.Font




.Name = "Arial"




.Size = 16




.Strikethrough = False




.Superscript = False




.Subscript = False




.OutlineFont = False




.Shadow = False




.Underline = xlUnderlineStyleNone




.ColorIndex = xlAutomatic




End With




'




Windows("Recherches Répertoire.xls").Activate




ActiveSheet.Unprotect










Workbooks("Generale.xls").Sheets("Listegenerale").Range("A14:I65517").AdvancedFilter Action _




:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _




("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A16:I65535"), _




Unique:=False




'




Windows("Generale.xls").Activate




Workbooks("Generale.xls").Close SaveChanges:=False




'




' Windows("Recherches Répertoire.xls").Activate










Application.ScreenUpdating = True




ActiveSheet.PROTECT




'




End Sub

1 réponse

Réponse 1 / 1
bobbob83 Messages postés 32 Date d'inscription vendredi 27 juillet 2007 Statut Membre Dernière intervention 22 novembre 2007
23 août 2007 à 13:24
bonjour




j'ai fais une macro de tri automatique pour pouvoir trier plusieur listes car si je fais une seul liste le fichier est trop gros et j'ai un message "mémoire insufisante"




chaque liste est dans un fichier Liste 1.xls, Liste 2.xls Liste 3.xls .... et la feuille s'appelle Liste 1, Liste 2 , Liste 3 ...


le fichier recherches répertoire contien la zone de critaire et c la que je copie le résultat final de la recherche
 

la macro filtre les listes de chaque ficher et copie le resutat dans Le fichier Filtre1 , filtre 2, filtre 3 ....

puis colle le resultat dans un fichier general.xls


la liste générale et filter puis copié dans recherche répertoire

vu que j'ai 37 fichiers de liste cela prend beaucoup de temps
 j'e voudrais savoir si le code est bon


pourriez vous me dire si il y a des erreurs de syntaxe svp merci




voila un extrait de la macro avec 5 fichiers liste





Sub Macro2()




' Macro2 Macro


' Macro enregistrée le 04/07/2007 par POSTE09






Sheets("Recherche répertoire").Select




Application.ScreenUpdating = False


Workbooks.Open Filename:= _



"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Generale.xls"




Sheets("Listegenerale").Select




Range("A15:I65526").Select




Selection.ClearContents


Workbooks.Open Filename:= _



"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste1.xls"






Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre1.xls"





Windows("Filtre1.xls").Activate


Workbooks("Liste1.xls").Sheets("Liste1").Range("B4:J65517").AdvancedFilter Action _

:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _

Unique:=False






Windows("Liste1.xls").Activate




Workbooks("Liste1.xls").Close SaveChanges:=False




Windows("Filtre1.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select


Selection.Copy






Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate


Application.CutCopyMode = False






Windows("Filtre1.xls").Activate




Workbooks("Filtre1.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste2.xls"


Workbooks.Open Filename:= _

"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre2.xls"






Windows("Filtre2.xls").Activate




Workbooks("Liste2.xls").Sheets("Liste2").Range("B4:J65517").AdvancedFilter Action _


:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _

Unique:=False






Windows("Liste2.xls").Activate




Workbooks("Liste2.xls").Close SaveChanges:=False




Windows("Filtre2.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select


Selection.Copy






Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False


Windows("Filtre2.xls").Activate






Workbooks("Filtre2.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste3.xls"




Workbooks.Open Filename:= _


"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre3.xls"

Windows("Filtre3.xls").Activate






Workbooks("Liste3.xls").Sheets("Liste3").Range("B4:J65517").AdvancedFilter Action _


:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _

Unique:=False






Windows("Liste3.xls").Activate




Workbooks("Liste3.xls").Close SaveChanges:=False




Windows("Filtre3.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select


Selection.Copy






Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




Application.CutCopyMode = False




Windows("Filtre3.xls").Activate




Workbooks("Filtre3.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _




"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste4.xls"


Workbooks.Open Filename:= _

"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre4.xls"






Windows("Filtre4.xls").Activate


Workbooks("Liste4.xls").Sheets("Liste4").Range("B4:J65517").AdvancedFilter Action _

:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _

Unique:=False






Windows("Liste4.xls").Activate




Workbooks("Liste4.xls").Close SaveChanges:=False




Windows("Filtre4.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select


Selection.Copy






Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate


Application.CutCopyMode = False






Windows("Filtre4.xls").Activate




Workbooks("Filtre4.xls").Close SaveChanges:=False




Workbooks.Open Filename:= _


"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Liste5.xls"

Workbooks.Open Filename:= _

"C:\Documents and Settings\POSTE09\Mes documents\Recherche Répertoire Liste\Filtre5.xls"






Windows("Filtre5.xls").Activate




Workbooks("Liste5.xls").Sheets("Liste5").Range("B4:J65517").AdvancedFilter Action _


:=xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A14:I65535"), _

Unique:=False






Windows("Liste5.xls").Activate




Workbooks("Liste5.xls").Close SaveChanges:=False




Windows("Filtre5.xls").Activate




Range("A15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select


Selection.Copy






Windows("Generale.xls").Activate




Sheets("Listegenerale").Select




Range("A15").Select




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate




ActiveSheet.Paste




Cells(16384, 1).End(xlUp).Select




Selection.Cells(2, 1).Activate


Application.CutCopyMode = False






Windows("Filtre5.xls").Activate




Workbooks("Filtre5.xls").Close SaveChanges:=False




Windows("Generale.xls").Activate




Range("a15").Select




Set tbl = ActiveCell.CurrentRegion




tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _




tbl.Columns.Count).Select




With Selection




.HorizontalAlignment = xlCenter




.VerticalAlignment = xlCenter




.WrapText = True




.Orientation = 0




.AddIndent = False




.ShrinkToFit = False




.MergeCells = False




End With




With Selection.Font




.Name = "Arial"




.Size = 16




.Strikethrough = False




.Superscript = False




.Subscript = False




.OutlineFont = False




.Shadow = False




.Underline = xlUnderlineStyleNone


.ColorIndex = xlAutomatic






End With






Windows("Recherches Répertoire.xls").Activate




ActiveSheet.Unprotect


Workbooks("Generale.xls").Sheets("Listegenerale").Range("A14:I65517").AdvancedFilter Action _

: =xlFilterCopy, CriteriaRange:=Workbooks("Recherches répertoire.xls").Sheets _

("Recherche Répertoire").Range("A10:I11"), CopyToRange:=Range("A16:I65535"), _

Unique:=False






Windows("Generale.xls").Activate




Workbooks("Generale.xls").Close SaveChanges:=False




Windows("Recherches Répertoire.xls").Activate




Application.ScreenUpdating = True




ActiveSheet.PROTECT




End Sub
0

Discussions similaires

EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Etablir menu de la semaine et liste de courses sous Excel
jacquandco -
deadhand -

1 réponse
Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin"
labriji -
labriji -

6 réponses
tangente et arctangente
unionx -
unionx -

2 réponses
Rejoignez-nous