casse-tête

Le
Bidou
Bonjour,

Je voudrais faire une macro en vba pour comparer les valeurs de deux
colonnes , recopier les valeurs des cellules concernées si elles sont
identiques en ajoutant la valeur située sur la même ligne mais quatre
colonnes plus loin et mon code ne fonctionne pas complètement et je ne
comprends pas pourquoi
Sub Bouton2_QuandClic()
Dim c1
Dim c2
For Each c1 In Range("base1")
For Each c2 In Range("base2")
If c1.Value <> "" And c1.Value = c2.Value Then
c1.Interior.ColorIndex = 6
c2.Interior.ColorIndex = 28
Range(c2, c2.Offset(, 2).Resize(, 2)).Copy
Worksheets("feuil2").Activate
[b1].End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
End If
Next c2
Next c1
End Sub

Merci de votre aide
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #19294641
Bonsoir,
Essayes avec ceci :

Sub Bouton2_QuandClic()
Dim c1 as range, c2 as range, mash as string
mash¬tivesheet.name
For Each c1 In Range("base1")
For Each c2 In Range("base2")
If c1.Value <> "" And c1.Value = c2.Value Then
c1.Interior.ColorIndex = 6
c2.Interior.ColorIndex = 28
Range(c2, c2.Offset(, 2).Resize(, 2)).Copy
Worksheets("feuil2").Activate
Cells(Range("b6543").End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
End If
Next c2
Next c1
Worksheet(mash).Activate
End Sub

--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
"Bidou" news:4a03dfbb$0$17766$
Bonjour,

Je voudrais faire une macro en vba pour comparer les valeurs de deux
colonnes , recopier les valeurs des cellules concernées si elles sont
identiques en ajoutant la valeur située sur la même ligne mais quatre
colonnes plus loin et mon code ne fonctionne pas complètement et je ne
comprends pas pourquoi
Sub Bouton2_QuandClic()
Dim c1
Dim c2
For Each c1 In Range("base1")
For Each c2 In Range("base2")
If c1.Value <> "" And c1.Value = c2.Value Then
c1.Interior.ColorIndex = 6
c2.Interior.ColorIndex = 28
Range(c2, c2.Offset(, 2).Resize(, 2)).Copy
Worksheets("feuil2").Activate
[b1].End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
End If
Next c2
Next c1
End Sub

Merci de votre aide



bidou
Le #19299311
Bonjour

Merci Philippe R de ton aide .Je l'ai essayé mais malheureusement il ne
fonctionne pas. En revanche j'ai trouvé celui qui suit qui a l'air de
fonctionner mais je ne sais pas trop pourquoi...

Dim c1 As Range, c2 As Range
For Each c1 In Range("base1")
For Each c2 In Range("base2")
If c1.Value <> "" And c1.Value = c2.Value Then
c1.Interior.ColorIndex = 6
c2.Interior.ColorIndex = 28
Range(c2, c2.Offset(, 2).Resize(, 6)).Copy
GoTo etiquette2
etiquette2:
Worksheets("feuil2").Select
Range("b5").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
End If
Next c2
Next c1
End Sub


"Bidou" 4a03dfbb$0$17766$
Bonjour,

Je voudrais faire une macro en vba pour comparer les valeurs de deux
colonnes , recopier les valeurs des cellules concernées si elles sont
identiques en ajoutant la valeur située sur la même ligne mais quatre
colonnes plus loin et mon code ne fonctionne pas complètement et je ne
comprends pas pourquoi
Sub Bouton2_QuandClic()
Dim c1
Dim c2
For Each c1 In Range("base1")
For Each c2 In Range("base2")
If c1.Value <> "" And c1.Value = c2.Value Then
c1.Interior.ColorIndex = 6
c2.Interior.ColorIndex = 28
Range(c2, c2.Offset(, 2).Resize(, 2)).Copy
Worksheets("feuil2").Activate
[b1].End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
End If
Next c2
Next c1
End Sub

Merci de votre aide



Publicité
Poster une réponse
Anonyme