Bonjour à tous,

je fais appel a vos connaissances,

J'ai une macro qui filtre dans un premier temps, puis copie les données et les colles dans un nouveaux fichier,

puis enregistre sous le nouveau fichier et supprime les données, et ceci doit recommencer 38 fois,

J'ai fait ma macro sur un test et donc faire cette commande 3 a 4 fois,

Mais du coup ma macro est très lente et longue,

est ce que quelqu'un peu m'aider à simplifier ma macro,

merci de votre aide

voici ma macro test :

Code VBA : 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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
   Windows("XECHS MATRICE.xlsx").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$Q$11635").AutoFilter Field:=2, Criteria1:="10"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy
        Windows("Balance Agee VIDE.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "E:\BALANCE\IDF"
    ActiveWorkbook.SaveAs Filename:="E:\BALANCE\IDF\Balance Agee 10.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Cells.Select
    Selection.ClearContents
    Windows("XECHS MATRICE.xlsx").Activate
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$Q$11635").AutoFilter Field:=2, Criteria1:="12"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("Balance Agee 10.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "E:\BALANCE\SUD"
    ActiveWorkbook.SaveAs Filename:="E:\BALANCE\SUD\Balance Agee 12.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Selection.ClearContents
    Sheets("Données Arcole Détaillées").Select
    Windows("XECHS MATRICE.xlsx").Activate
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$Q$11635").AutoFilter Field:=2, Criteria1:="13"
    ActiveWindow.SmallScroll Down:=285
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollRow = 2378
    ActiveWindow.ScrollRow = 11889
    ActiveWindow.ScrollRow = 14266
    ActiveWindow.ScrollRow = 35665
    ActiveWindow.ScrollRow = 33288
    ActiveWindow.ScrollRow = 21399
    ActiveWindow.ScrollRow = 1
    Selection.Copy
    Windows("Balance Agee 12.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "E:\BALANCE\IDF"
    ActiveWorkbook.SaveAs Filename:="E:\BALANCE\IDF\Balance Agee 13.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Selection.ClearContents
    Windows("XECHS MATRICE.xlsx").Activate
    ActiveSheet.Range("$A$1:$Q$11635").AutoFilter Field:=2, Criteria1:="=45", _
        Operator:=xlOr, Criteria2:="=46"
    Selection.Copy
    Windows("Balance Agee 13.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "E:\BALANCE\ES OUEST"
    ActiveWorkbook.SaveAs Filename:="E:\BALANCE\ES OUEST\Balance Agee 46.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Selection.ClearContents
    Windows("XECHS MATRICE.xlsx").Activate
    ActiveSheet.Range("$A$1:$Q$11635").AutoFilter Field:=2, Criteria1:="36"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("Balance Agee 46.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=507
    Windows("XECHS MATRICE.xlsx").Activate
    ActiveWindow.SmallScroll Down:=27
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.SmallScroll Down:=75
    Windows("Balance Agee 46.xlsx").Activate
    ActiveWindow.SmallScroll Down:=-99
    Application.CutCopyMode = False
    ChDir "E:\BALANCE"
    ActiveWorkbook.SaveAs Filename:="E:\BALANCE\Balance Agee 36.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

Merci de votre aide