Macro de comparaison et transfert de données

Question

Bonjour à tous,

Je suis complètement débutant en VBA or j'aurais besoin de réaliser un petit programme permettant de : 
                  
1) Comparer des valeurs d'une colonne dans une feuille 1 avec les valeurs d'une colonne       dans une feuille 2

2) Si il y a égalité entre deux valeurs il faut copier la ligne de la feuille 1 correspondante dans une feuille 3.

Ci-dessous la macro que j'ai pu faire :

Sub Compare()
  Dim derlig As Long, L As Long, M As Long
  Dim col As Range
    Application.ScreenUpdating = False
    With Worksheets("Feuil1")
    derlig = .Range("A" & Rows.Count).End(xlUp).Row
      For L = derlig To 11 Step -1                         'première boucle FOR, qui permet de balayer toutes les cases du classeur A
        Set col = .Range("C" & L).Value                    
        With Worksheets("Feuil2")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
            For M = derlig To 1 Step -1                    'Balayage de toutes les valeurs du classeur B
                If col = Cells(M, 2) Then                  'Comparaison des 2 
                    With Worksheets("Feuil1")
                        Rows("A" & L).Select
                        Selection.Copy
                    End With
                    With Worksheets("Feuil3").Select
                        Rows("14:14").Select               'J'ai besoin d'insérer à partir de la 14ième ligne
                        .Range("A", 14).Offset(1, 0).EntireRow.Insert Shift:=xlDown
                        ActiveSheet.Paste
                    End With
                End If
            Next M
        End With
      Next L
    End With
End Sub



Le programme me renvoi une erreur ligne 9/10 (434)
Avez-vous une solution s'il vous plait ?

Dans le lien suivant vous trouverez mon fichier test : https://www.cjoint.com/?0Dtqa19uQG8


Je vous remercie par avance,
Cordialement,

Hugo

f894009 · Answer

Bonjour,

a essayer:

Sub Compare()
  Dim derlig As Long, derlig1 As Long, L As Long, M As Long
  Dim col As Range
    Application.ScreenUpdating = False
    Windows("classeurA").Activate
    With Worksheets("Feuil1")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For L = derlig To 11 Step -1                         'première boucle FOR, qui permet de balayer toutes les cases du classeur A
            Set col = .Range("K" & L).Value
            Windows("ClasseurB").Activate
            With Worksheets("Feuil2")
                derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
                For M = derlig1 To 1 Step -1                    'Balayage de toutes les valeurs du classeur B
                    If col = .Cells(M, 3) Then                  'Comparaison des 2
                        Windows("ClasseurA").Activate
                        With Worksheets("Feuille1")
                            .Rows("A" & L).Select
                            Selection.Copy
                        End With
                        Windows("ClasseurC").Activate
                        With Worksheets("Feuil1")
                            .Rows("14:14").Select               'J'ai besoin d'insérer à partir de la 14ième ligne
                            .Range("A", 14).Offset(1, 0).EntireRow.Insert Shift:=xlDown
                            ActiveSheet.Paste
                        End With
                    End If
                Next M
            End With
        Next L
    End With
End Sub

Macro de comparaison et transfert de données

1 réponse

Discussions similaires

Newsletters