Macro de comparaison et transfert de données
Hugoh
Messages postés
1
Date d'inscription
Statut
Membre
Dernière intervention
-
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
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 :
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
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
A voir également:
- Macro de comparaison et transfert de données
- Fuite données maif - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Comparaison million milliard - Accueil - Technologies
- Supprimer les données de navigation - Guide
- Transfert de mail - Guide
1 réponse
Bonjour,
a essayer:
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