retoucher et corriger la macro

[myexcel_]

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("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("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

 

[herve62]

Bonjour
Juste vite fait pourquoi au début tu fais :Set ws_CM2 = Sheets("CM2") , cette feuille n'existe pas ?? donc erreur

 

[myexcel_]

oups .... CM2 c'est vitrine2.

voila j'ai modifié le fichier en joint

 

[herve62]

tu as supprimé ton fichier ici ? pourquoi ?
sinon tu mets les bons noms de CM2 à 5 ( attention Vitrine2 a une maj. pas les autres)
et cela fonctionne bien
Bon Noël

 

[myexcel_]

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

 

[herve62]

Non ton fichier est correct mais on peut faire court
Vite fait regarde , mais j'ai pas le temps de tout vérifier , j'ai lancé c'est OK

Je pars , ne rentre que demain

 

[myexcel_]

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

 

[myexcel_]

le vrai fichier avec les vrais noms

 

[herve62]

Desolé je pars de suite reveillon
C'est une boucle adaptable

 

[myexcel_]

Ok....on en parlera une fois le réveillon terminé 🙂 amuse toi bien

 

[herve62]

Bonjour , Slt myexcel
Voilà on reprend ses activités passe-temps . J'ai repris au plus court pour le même résultat
si tu veux ajouter des onglets sur le même principe , rien à modifier

 

[myexcel_]

Re
vous avez laissé l'ancienne macro ?

 

[herve62]

Yups !! oubli , va dans ton bouton et affecte la macro "Repartie" du module2

 

[myexcel_]

Merci beaucoup...ça marche très bien