retoucher une macro

Version imprimable

1 pièce(s) jointe(s)

retoucher une macro

bonjour
J'avais un fichier où j'exécuter une macro pour exporter les données de la feuille CM1 vers un autre tableau d'une autre feuille. J'ai décidé de créer 3 autres feuilles et faire la même manip. Pour faire, j'ai calqué le même code 3 fois.
y a t il un moyen de faire court ou de supprimer les lignes inutiles dans la nouvelle macro élargie.

voici le code final répété 3 fois

Code:

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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub Macro1()
 
' ---------Export vers feuille2
 
Application.ScreenUpdating = False
 
Set ws_user = Sheets("utilisateurs")
Set ws_CM2 = Sheets("vit")
Set ws_CM1 = Sheets("CM1")
 
NbLigCM1 = ws_CM1.[A1].CurrentRegion.Rows.Count
NbParam = ws_user.[K1].CurrentRegion.Rows.Count
NbLigCM2 = ws_CM2.[A1].CurrentRegion.Rows.Count - 1
 
NbExport = 0
 
For i = 2 To NbParam
    For j = 2 To NbLigCM1
        If (ws_CM1.Cells(j, "K") = ws_user.Cells(i, "K")) Then
            ws_CM1.Rows(j).Copy Destination:=ws_CM2.Rows(2 + NbLigCM2)
            NbLigCM2 = NbLigCM2 + 1
            NbExport = NbExport + 1
            ws_CM1.Rows(j).Delete
            j = j - 1
        End If
    Next
Next
 
Application.ScreenUpdating = True
 
 '----------------Export vers feuille3
 
 Application.ScreenUpdating = False
 
Set ws_user = Sheets("utilisateurs")
Set ws_CM3 = Sheets("dar")
Set ws_CM1 = Sheets("CM1")
 
NbLigCM1 = ws_CM1.[A1].CurrentRegion.Rows.Count
NbParam = ws_user.[K1].CurrentRegion.Rows.Count
NbLigCM3 = ws_CM3.[A1].CurrentRegion.Rows.Count - 1
 
NbExport = 0
 
For i = 2 To NbParam
    For j = 2 To NbLigCM1
        If (ws_CM1.Cells(j, "K") = ws_user.Cells(i, "L")) Then
            ws_CM1.Rows(j).Copy Destination:=ws_CM3.Rows(2 + NbLigCM3)
            NbLigCM3 = NbLigCM3 + 1
            NbExport = NbExport + 1
            ws_CM1.Rows(j).Delete
            j = j - 1
        End If
    Next
Next
 
Application.ScreenUpdating = True
 
'----------------Export vers feuille4
 
 Application.ScreenUpdating = False
 
Set ws_user = Sheets("utilisateurs")
Set ws_CM4 = Sheets("arr")
Set ws_CM1 = Sheets("CM1")
 
NbLigCM1 = ws_CM1.[A1].CurrentRegion.Rows.Count
NbParam = ws_user.[K1].CurrentRegion.Rows.Count
NbLigCM4 = ws_CM4.[A1].CurrentRegion.Rows.Count - 1
 
NbExport = 0
 
For i = 2 To NbParam
    For j = 2 To NbLigCM1
        If (ws_CM1.Cells(j, "K") = ws_user.Cells(i, "M")) Then
            ws_CM1.Rows(j).Copy Destination:=ws_CM4.Rows(2 + NbLigCM4)
            NbLigCM4 = NbLigCM4 + 1
            NbExport = NbExport + 1
            ws_CM1.Rows(j).Delete
            j = j - 1
        End If
    Next
Next
 
Application.ScreenUpdating = True
 
'-------Export vers feuille5
Application.ScreenUpdating = False
 
Set ws_user = Sheets("utilisateurs")
Set ws_CM5 = Sheets("cre")
Set ws_CM1 = Sheets("CM1")
 
NbLigCM1 = ws_CM1.[A1].CurrentRegion.Rows.Count
NbParam = ws_user.[K1].CurrentRegion.Rows.Count
NbLigCM5 = ws_CM5.[A1].CurrentRegion.Rows.Count - 1
 
NbExport = 0
 
For i = 2 To NbParam
    For j = 2 To NbLigCM1
        If (ws_CM1.Cells(j, "K") = ws_user.Cells(i, "N")) Then
            ws_CM1.Rows(j).Copy Destination:=ws_CM5.Rows(2 + NbLigCM5)
            NbLigCM5 = NbLigCM5 + 1
            NbExport = NbExport + 1
            ws_CM1.Rows(j).Delete
            j = j - 1
        End If
    Next
Next
 
Application.ScreenUpdating = True
 
End Sub

25/12/2019, 15h31
Philippe Tulliez
Bonjour,
Je n'ouvre pas les fichiers joints.
D'après la lecture de ton code, j'imagine que la liste des données "source" et "cible" sont des plages normales (pas des tableaux structurés)
Si l'on est amené à effectuer souvent ce genre d'opération et il est évident que quelque soit le langage utilisé on est amené à copier régulièrement des données "source" vers une "cible", je ne peux que te conseiller de créer une procédure indépendante qui a pour tâche de faire ce travail.
Procédure qui aura au minimum deux arguments, l'objet "Source" et l'objet "Cible" avec en option un argument qui indique si l'on copie la source à la suite des données déjà existantes dans la "cible)
Ainsi le travail en amont de l'appel à cette procédure ne fait que gérer la boucle et éventuellement l'ouverture des classeurs "cible" si la copie à lieu dans un autre classeur

J'ai développer deux procédures publiées dans les contributions.
L'une qui est "clé sur porte" avec vérification du nombre de colonnes ainsi que de l'orthographe des étiquettes qui doivent être évidemment identiques et l'une plus simple à comprendre et sans vérification aucune
- Regrouper plusieurs feuilles sur une autre. (2003-2010)
- CopyRange - Copie de liste de données (source) dans une feuille cible
25/12/2019, 16h34
anareda

Merci
Moi c'est le contraire de la procédure export que je veux...je veux dissocier la premier feuille en plusieurs et non regrouper des feuilles en une
25/12/2019, 16h49
Philippe Tulliez

Bonjour,

Citation:

Moi c'est le contraire de la procédure export que je veux...je veux dissocier la premier feuille en plusieurs et non regrouper des feuilles en une

Alors pour cela, je conseille la méthode AdvancedFilter (filtre avancé d'excel), très simple à mettre en place

En attendant, je conseille la lecture de ce tutoriel Les filtres avancés ou élaborés dans Excel

En fonction de quel critère les données doivent elle être éclatées ?