retoucher et corriger la macro

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

  • triple macro1.xlsm
    30.3 KB · Affichages: 0
Dernière édition:

myexcel_

XLDnaute Nouveau
oui je l'ai supprimé et remplacé...faut pas faire attention aux noms des feuilles (je vais mettre les vrais noms après)....le but c'est de voir q'il y a des lignes doublons à supprimer.
le voila le fichier
 

Pièces jointes

  • triple macro1.xlsm
    28.5 KB · Affichages: 3

myexcel_

XLDnaute Nouveau
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:
Haut Bas