Bonjour a tous,
Je souhaiterais savoir s'il y a un moyen d'optimiser cette macro. Je m'explique : la première feuille "ITEX_04_2014_ADR2" est la source, selon des critères (colonne D qui sont des libelles) je dois les regrouper dans les onglets correspondants que je créé par la même occasion.
Donc pour chaque libelle différent une feuille de mon classeur est créée.
C'est ici que je m'interroge et vous devriez comprendre avec ma macro car j'ai une cinquantaine de libelle et ma macro risque d'être un chouia longue si je continue sur ce modèle
Ci-dessous avec seulement deux libelles (A0DNK3 et A0DNK5) :
Merci d'avance
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65 Sub Delete_Column() Range("Q:Q,S:U,W:AI").Select Range("AI1").Activate Selection.Delete Shift:=xlToLeft End Sub Sub Funds() Application.ScreenUpdating = False Range("D1").AutoFilter Field:=4, Criteria1:="A0DNK3", Operator:=xlOr, Criteria2:="A0DNK5" Sheets.Add , Worksheets(Worksheets.Count) ActiveSheet.Name = "A0DNK3" Sheets("A0DNK3").Range("A1:R1").Value = Sheets("ITEX_04_2014_ADR2").Range("A1:R1").Value Sheets.Add , Worksheets(Worksheets.Count) ActiveSheet.Name = "A0DNK5" Sheets("A0DNK5").Range("A1:R1").Value = Sheets("ITEX_04_2014_ADR2").Range("A1:R1").Value Dim i As Long Dim j As Integer Dim sh As Worksheet Dim feuillePrincipale As Worksheet Dim dnk3Sheet As Worksheet Dim dnk5Sheet As Worksheet Set feuillePrincipale = ThisWorkbook.Sheets("ITEX_04_2014_ADR2") Set dnk3Sheet = ThisWorkbook.Sheets("A0DNK3") Set dnk5Sheet = ThisWorkbook.Sheets("A0DNK5") For Each sh In ThisWorkbook.Worksheets If sh.Name = "A0DNK3" Then i = 2 j = 2 While Not IsEmpty(feuillePrincipale.Cells(i, 1)) If feuillePrincipale.Cells(i, 4).Value = "A0DNK3" Then feuillePrincipale.Cells.Rows(i).EntireRow.Copy dnk3Sheet.Rows(j) j = j + 1 End If i = i + 1 Wend End If If sh.Name = "A0DNK5" Then i = 2 j = 2 While Not IsEmpty(feuillePrincipale.Cells(i, 1)) If feuillePrincipale.Cells(i, 4).Value = "A0DNK5" Then feuillePrincipale.Cells.Rows(i).EntireRow.Copy dnk5Sheet.Rows(j) j = j + 1 End If i = i + 1 Wend End If Next Application.ScreenUpdating = True End Sub
Bien cordialement,
Christophe
Partager