Copier-coller_si_2cellules_sont_identiques_dans_autre-onglet

Bonjour

J'ai besoin de votre soutien pour finaliser un post copier/coller avec condition avec une macro si possible

Ma requête, merci d'avance pour votre aide si cela est faisable :

-de copier coller suivant 1 condition si des lignes du tableau FEUIL1

comprend 2 textes ' Lundi ' et ' abc'

et également

comprend 2 textes ' Mercredi' et ' bde'

de copier toutes les lignes afin de les transférées dans l'onglet de la Feuil2

merci, je joins le fichier

j'ai cela pour effacer

Dim I As Integer
For I = 300 To 1 Step -1
    If Not Cells(I, 1).Resize(1, 6).Find("Lundi") Is Nothing Then Rows(I).Delete
Next I

Sub Renouvellement_Norm()
    Dim plage As Range, cel As Range
    'stop rafraichissement ecran
    Application.ScreenUpdating = False
                     ' valeur à chercher
    valcherch = "lundi"
    With Worksheets("Feuil1")
        'derniere cellule colonne A
         derlig = .Range("A" & Rows.Count).End(xlUp).Row
        'definition plage à tester en memoire
        Set plage = .Range("A1:ZA" & derlig)
    End With

    derlig = 0
    With Worksheets("Feuil2")
        'test plage
        For Each cel In plage
            If cel = valcherch Then
                'premiere cellule vide apres derniere non vide colonne D
                derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
                'premier lancement
                If derlig = 2 Then
                    derlig = 9
                End If
                'copier la  ligne entière
                cel.EntireRow.Copy .Range("A" & derlig)
            End If
        Next cel
    End With
    ' rafraichissement ecran
    Application.ScreenUpdating = True
End Sub

merci d'avance

crdlt,

André

Bonjour,

j'aurais vu ça de cette manière

P.

Option Explicit
Sub Renouvellement_Norm()
Dim Plage As Range, cel As Range
Dim valcherch1, valcherch2 As String
Dim I&, derlig&, Last&
Dim Desti
'stop rafraichissement ecran
Application.ScreenUpdating = False
' valeur à chercher
Dim Ws1, Ws2 As Worksheet
Set Ws1 = Sheets("feuil1"): Set Ws2 = Sheets("feuil2")
valcherch1 = "lundi"
valcherch2 = "abc"
derlig = 0
Last = Ws1.[A65000].End(xlUp).Row
'test plage
For I = 2 To Last
   If UCase(Ws1.Cells(I, 4)) = UCase(valcherch1) And UCase(Ws1.Cells(I, 1)) = UCase("abc") Then
      Set Desti = Ws2.[A65000].End(xlUp)
'premiere cellule vide apres derniere non vide colonne A
      Ws1.Range(Cells(I, 1), Cells(I, 4)).Copy Destination:=Desti(2)
   End If
Next I
Application.ScreenUpdating = True
End Sub

Merci Patrick1957

Bien plus propre je vais testé merci pour le coup de pouce

Edit : trop fort çà fonctionne à merveille, me reste plus qu'à mettre les deux autres occurrences avec 2 variables et le tour et joué Perfect ! merciiii

je joins le fichier si jamais quelqu'un en a besoin

crdlt,

André