Copier cellule d'une liste sous conditions

[Sach]

Bonjour,

J'essaye de copier sous conditions chaque ligne d'une liste sur une autre feuille du même classeur.

Il faut que la valeur, sur la feuille 1, de chaque cellule de la colonne A soit égale à celle de la feuille 2 pour copier la ligne entière sur la feuille 2 et ainsi de suite.

Mais la ligne se copie malgré que les conditions ne soit pas respectées...

Voici le code :

Sub TEST()

  Dim Ligne   As Long
  Dim NbLi    As Long
  Dim NumLi   As Long
  Dim Colonne As String
  
  Sheets("Feuil2").Activate
  
  Colonne = "A"
  NumLi = 0
  With Sheets("Feuil1")
  NbLi = .Cells(65536, Col).End(xlUp).Row
  For Ligne = 1 To NbLi
 
   If .Cells(Ligne, Colonne).Value = ActiveSheet.Cells(Ligne, Colonne).Value Then
      .Cells(Ligne, Colonne).EntireRow.Copy
      NumLi = NumLi + 1
      Cells(NumLi, 1).Select
      ActiveSheet.Paste
    End If
    Next
    End With
End Sub

Et un fichier exemple

 

[Guest]

Re : Copier cellule d'une liste sous conditions

bonjour Sach,

Macro que tu peux lancer de la feuil1 ou la feuil2:

Sub TEST()
    Dim PlageRefs As Range
    Dim ligne As Long
    Dim idx As Variant
    With Sheets("Feuil1")
        Set PlageRefs = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With
    With Sheets("Feuil2")
        For ligne = 1 To .Cells(65536, 1).End(xlUp).Row
            idx = Application.Match(.Cells(ligne, 1), PlageRefs, 0)
            If Not IsError(idx) Then
                PlageRefs.Cells(idx, 2).Resize(, 2).Copy Destination:=.Cells(ligne, 2)
            End If
        Next
    End With
End Sub

A+

 

[Sach]

Re : Copier cellule d'une liste sous conditions

Merci beaucoup !

C'est exactement ce que je voulais