Retoucher cette macro

Le 25/12/2019 à 08:52

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

Sub Macro1()

' ---------Export vers feuille2

Application.ScreenUpdating = False

Set ws_user = Sheets("utilisateurs")
Set ws_CM2 = Sheets("vitrine2")
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.

Sub Macro1()

' ---------Export vers feuille2

Application.ScreenUpdating = False

Set ws_user = Sheets("utilisateurs")
Set ws_CM2 = Sheets("vitrine2")
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("vitrine3")
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("vitrine4")
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("vitrine5")
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
Le 25/12/2019 à 08:58

Bonjour,

Je dirais qu'au lieu de tripler la macro, une boucle sur les trois feuilles aurait fait le même boulot

Le 25/12/2019 à 08:59

Supprimer : doublons

Le 25/12/2019 à 09:05

justement comment supprimer les doublons sans affecter la macro ...je n'ose pas y toucher.

je vous met en attache le fichier en question.

3triple-macro1.xlsm (30.90 Ko)
Le 25/12/2019 à 11:54

je ne sais pas comment éditer le premier message.

je vais le corriger ici

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

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.

Sub Macro1()

' ---------Export vers feuille2

Application.ScreenUpdating = False

Set ws_user = Sheets("utilisateurs")
Set ws_CM2 = Sheets("vitrine2")
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("vitrine3")
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("vitrine4")
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("vitrine5")
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
3triple-macro1.xlsm (28.82 Ko)
Rechercher des sujets similaires à "retoucher cette macro"