comparer et copier

[ediu]

Bonjour,

Je cherche à comparer 2 cellules de 2 onglets et copier les informations du 2e onglet à la suite des informations du 1er onglet si les valeurs des 2 cellules comparées sont les mêmes.

Sub copie()
Dim ValComp As Integer
Dim LastLig As Long, i As Long, e As Long
Dim Valeur1 As String, Valeur2 As String

ValComp = 2
LastLig = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
e = 2
For i = 2 To LastLig
e = i
    Valeur1 = Sheets(1).Cells(i, ValComp)
    Valeur2 = Sheets(2).Cells(e, ValComp)
        If Valeur1 <> Valeur2 Then
            e = i + 1                
                Else: With Sheets(1)
                    .Cells(i, 11) = Sheets(2).Cells(e, 2)
                    .Cells(i, 12) = Sheets(2).Cells(e, 7)
                    .Cells(i, 13) = Sheets(2).Cells(e, 8)
                    .Cells(i, 14) = Sheets(2).Cells(e, 9)
                    .Cells(i, 15) = Sheets(2).Cells(e, 10)
                End With
            
        End If
Next i
    End Sub

Mais cela ne fonctionne pas.
Cela fonctionne pour la première ligne car les valeurs1 et 2 sont égales.
mais ensuite je ne parviens pas à comparer la ligne 2 de la sheet1 avec la ligne 2 de la sheet 2.
Quelqu'un pourrait-il m'aider ?
Merci
ed

 

[ediu]

Re : comparer et copier

up... help...

 

[Bebere]

Re : comparer et copier

bonjour Ediu
à tester

Sub copie()
Dim ValComp As Integer
Dim LastLig As Long, i As Long, j As Long, l As Long
Dim Valeur1 As String, Valeur2 As String

ValComp = 2
LastLig1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LastLig2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastLig1
Valeur1 = Sheets(1).Cells(i, ValComp)
For j = 2 To LastLig2
Valeur2 = Sheets(2).Cells(j, ValComp)
If Valeur1 = Valeur2 Then
With Sheets(1)
l = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(l, 11) = Sheets(2).Cells(j, 2)
.Cells(l, 12) = Sheets(2).Cells(j, 7)
.Cells(l, 13) = Sheets(2).Cells(j, 8)
.Cells(l, 14) = Sheets(2).Cells(j, 9)
.Cells(l, 15) = Sheets(2).Cells(j, 10)
End With
' Exit For 'si qu'une concordance à trouver enlève ' en début de ligne
End If
Next i
Next j
End Sub
à bientôt

 

[ediu]

Re : comparer et copier

Merci bebere de m'avoir mis sur la voie.
ma macro fonctionne maintenant .

Cependant, j'ai un paramètre supplémentaire à prendre en compte et je ne sais pas bien comment.

Il est possible que dans la sheets(2), il y ait plusieurs fois la valeur1 de la sheets(1)
Je souhaiterais si c'est possible, insérer une ligne juste en dessous et mettre les données des valeur2
Mais je ne sais pas comment m'y prendre.

Merci pour votre aide.

Ma macro

Sub copie()
Dim ValComp As Integer
Dim LastLig1 As Long, LastLig2 As Long, i As Long, e As Long
Dim Valeur1, Valeur2

ValComp = 2
LastLig1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LastLig2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastLig1
    Valeur1 = Sheets(1).Cells(i, ValComp)
For e = 2 To LastLig2
    Valeur2 = Sheets(2).Cells(e, ValComp)
    
If Valeur1 <> Valeur2 Then
   e = e + 1
   Valeur2 = Sheets(2).Cells(e, ValComp)
End If

If Valeur1 = Valeur2 Then
   With Sheets(1)
        .Cells(i, 12) = Sheets(2).Cells(e, 2)
        .Cells(i, 13) = Sheets(2).Cells(e, 3)
        .Cells(i, 14) = Sheets(2).Cells(e, 4)
   End With
End If
Next e
Next i
End Sub

 

[Bebere]

Re : comparer et copier

Ediu
avec un fichier ce serait plus facile
le code de tantôt inverser i et j(next)
j'employerais find pour rechercher,bien plus rapide
à bientôt