Macro compare 2 colonnes/recopie plage
Résolu
zagus
Messages postés
42
Date d'inscription
Statut
Membre
Dernière intervention
-
zagus Messages postés 42 Date d'inscription Statut Membre Dernière intervention -
zagus Messages postés 42 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
j'ai besoin de comparer deux colonnes dans deux onglets differents ( p11 et sauvegarde ) et si le resultat est le meme dans les deux colonnes. Il faut que la macro selectionne une plage de donnée dans l'onglet "sauvegarde" et me la recopie dans l'onglet "p11".
J'ai ecris cette macro mais elle ne fonctionne pas et ne selectionne qu'une cellule à copier au lieu d'une plage de cellule.
Pouvez vous m'aider et me dire ce qui ne va pas dans ce que j'ai ecris.
En vous remerciant pour votre aide
Sub reporting()
Sheets("p11").Activate
Dim i As Integer
Dim j As Integer
i = 1
Do While i < 2000
Sheets("p11").Activate
ActiveSheet.Cells(c, 1).Activate
If ActiveCell.Value <> 0 Then
For j = 1 To 2000
If ActiveCell.Value = Sheets("sauvegarde").Cells(c, 1).Value Then
Sheets("sauvegarde").Activate
ActiveSheet.Cells(n, 1).Select
Selection.Copy
Sheets("p11").Activate
ActiveSheet.Cells(n, 1).Select
ActiveSheet.Paste
End If
Next j
End If
i = i + 1
Loop
End Sub
j'ai besoin de comparer deux colonnes dans deux onglets differents ( p11 et sauvegarde ) et si le resultat est le meme dans les deux colonnes. Il faut que la macro selectionne une plage de donnée dans l'onglet "sauvegarde" et me la recopie dans l'onglet "p11".
J'ai ecris cette macro mais elle ne fonctionne pas et ne selectionne qu'une cellule à copier au lieu d'une plage de cellule.
Pouvez vous m'aider et me dire ce qui ne va pas dans ce que j'ai ecris.
En vous remerciant pour votre aide
Sub reporting()
Sheets("p11").Activate
Dim i As Integer
Dim j As Integer
i = 1
Do While i < 2000
Sheets("p11").Activate
ActiveSheet.Cells(c, 1).Activate
If ActiveCell.Value <> 0 Then
For j = 1 To 2000
If ActiveCell.Value = Sheets("sauvegarde").Cells(c, 1).Value Then
Sheets("sauvegarde").Activate
ActiveSheet.Cells(n, 1).Select
Selection.Copy
Sheets("p11").Activate
ActiveSheet.Cells(n, 1).Select
ActiveSheet.Paste
End If
Next j
End If
i = i + 1
Loop
End Sub
Configuration: Windows 2000 Internet Explorer 6.0
3 réponses
-
j'ai essayé ca aussi que j'ai trouvé sur le forum mais ca ne marche toujours pas..
please help !!
Sub reporting()
LigDeb = 1
LigFin = 500
ii = LigDeb
jj = LigDeb
Do
If Sheets("p11").Cells(ii, "c") = Sheets("sauvegarde").Cells(ii, "c") Then
Sheets("sauvegarde").Cells(ii, "c").EntireRow.Copy
Sheets("p11").Rows(jj & ":" & jj).PasteSpecial
jj = jj + 1
LigFin = LigFin - 1
Else
ii = ii + 1
End If
Loop While ii < LigFin
End Sub -
la 2 eme macro marche mais elle ne recopie rein...
-
j'ai finalement reussi à faire ce que je voulais cependant, je ne l'ai fait que pour une feuille. c'est à dire que je ne compare que la feuille 1 à la feuille 2 cependant j'ai encore 5 autres feuilles à comparer à la feuille 2..
est-ce que quelqu'un pourrait m'aider?
En vous remerciant par avance
Sub COMPAR()
Application.ScreenUpdating = False
'declaration des variables'
Dim VALEURA As String, i As Integer, x As Integer, valeurB As String
'i correspondra au numeros de ligne dans la feuille 1'
i = 3
'continuer tant que i n'est pas egal à 50'
Do While i <> "50"
'donner une valeur de départ à VALEURA, valeura=le contenue de A2'
VALEURA = range("c" & i).Value
'activer la feuille 2'
Sheets("Feuil2").Select
'x correspond au numeros de ligne dans la feuille 2'
x = 3
'donner une valeur de depart a valeurb'
valeurB = range("c" & x).Value
'comparer valeura et valeurb, tant que faux incrementer x de 1'
Do While VALEURA <> valeurB
x = x + 1
If x = 50 Then GoTo l49
valeurB = range("c" & x).Value
Loop
If VALEURA = valeurB Then
range("j" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("J" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("k" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("k" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("l" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("l" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("m" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("M" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("n" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("n" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("o" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("o" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("p" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("p" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("q" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("q" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("r" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("r" & i).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
range("s" & x).Select
Selection.Copy
Sheets("Feuil1").Select
range("s" & i).Select
ActiveSheet.Paste
End If
'on incremente i de 1'
l49:
i = i + 1
'on continue les fonction d'avant jusqu'a ce que i=50'
Loop
End Sub
-
-
mon problème est résolu ... en remerciant Fring.
voici donc le code qui me permet de comparer tous les onglets à l'onglet sauvegarde et qui recopie de "j" à "s"
Sub COMPAR()
Application.ScreenUpdating = False
'declaration des variables'
Dim Cel As range, WSHsauv As Worksheet, WSHp As Worksheet
Dim i As Integer, x As Integer, k As Integer, FL As Variant
Set WSHsauv = Worksheets("sauvegarde")
FL = Array("p11", "p12", "p13", "p14", "p15", "p45")
For k = 0 To UBound(FL)
Set WSHp = Sheets(FL(k))
For i = 3 To WSHp.range("C65535").End(xlUp).Row '<-- de la ligne 3 à la dernière ligne de la colonne C de la feuille "p..."
Set Cel = WSHsauv.range("a:a").Find(what:=WSHp.range("a" & i), lookat:=xlWhole) '<-- recherche des valeurs dans la colonne C de la feuille "sauvegarde"
If Not Cel Is Nothing Then '<-- si la valeur est trouvée
x = Cel.Row
WSHsauv.range("J" & x & ":S" & x).Copy WSHp.range("J" & i) '<-- alors on copie les cellules des colonnes J à S
End If
Next i
Next k
'libération de la mémoire
Set Cel = Nothing
Set WSHsauv = Nothing
Set WSHp = Nothing
End Sub
