retoucher et corriger la macro

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

myexcel_

XLDnaute Nouveau
Bonjour

j'ai adapté 1 macro suivant mon nouveau fichier (créé par un membre que je remercie...relancé sans suite..apparemment en congé)
la macro initiale se chargeait d'exporter les données de la feuille CM1 vers la feuille CM2 (pour des lignes qui contenait dans la colonne K (cm1) un certains code présent dans la colonne K de la feuille utilisateur.

le code initial était
Code:
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

End Sub

donc je voulais ajouter l'export des données vers 3 nouvelles feuilles....alors j'ai calque le code VBA 3 fois et ça marche...je voudrais juste vous demander de voir s'il y a des lignes inutiles dans mon nouveau code...et Merci infinement.

Code:
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
 

Pièces jointes

Dernière édition:
repose toi 🙂
c'est très bien fait...juste une chose les vrais noms de fichiers ne se nommeront pas vitrine de 1 à 5....car j'ai remarqué que tu utilisé une seule (factorisation 🙂

en plus je crois tu as corrigé le premier code.....moi je veux corrigé le deuxième
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
233
Réponses
8
Affichages
468
Réponses
10
Affichages
281
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
171
Réponses
3
Affichages
665
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
5
Affichages
182
Retour