Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

casse-tête

2 réponses
Avatar
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:=False
Application.CutCopyMode = False
End If
Next c2
Next c1
End Sub

Merci de votre aide

2 réponses

Avatar
Philippe.R
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" a écrit dans le message de
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



Avatar
bidou
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" a écrit dans le message de 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