Boucle si plusieurs valeurs égale à une valeur de référence

Hello les amis,

Je but sur mon projet vba:

J’ai une liste de dates en colonne A de ma feuille 1

Une liste de chiffre en colonne B de ma feuille 1

Et une date fixe en cellule C1 de ma feuille 1

Exemple:

11/02/2019 1 11/02/2019

14/02/2019 2

11/02/2019 10

Mon but est le suivant : pour toute les dates de la colonne A égale à la date située en cellule C1 alors sélectionner les lignes correspondante et les copier coller en feuille 2 à partir de la deuxième ligne de la feuille 2.

Voici mon code :

Dim Date1 As Range

Dim Date2 as Range

Dim Date3 as Range

Dim Trouve As Range

Dim A As Range

Set Date1 = Worksheets("Sheet1").Range("A1:A10")

Set Date2 = Worksheets("Sheet1").Range("C1")

Set Date3 = Worksheets("Sheet2").Range("A2:A10")

For Each A In Date1

Set Trouve = Date2.Find(A.Value, , xlValues, xlWhole)

If Not Trouve is nothingThen

Date3.Offset(, 0).Value = A.Offset(, 0).Value

Date3.Offset(, 1).Value = A.Offset(, 1).Value

End If

Next A

Je ne comprends pas ou ça bug et j’imagine qu’il y a bcp plus simple, avez vous des idées pour que ça marche svp ?

Merci,

Hugo

Salut hugo.c

Sub test()

Set Date1 = Worksheets("Sheet1")
Set Date2 = Worksheets("Sheet2")

DateC = Date1.Range("C1")
drnlgn1 = Date1.Cells(Rows.Count, "A").End(xlUp).Row
drnlgn2 = Date2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To drnlgn
    If Date1.Cells(i, "A").Value = DateC.Value Then
       drnlgn2 = drnlgn2 + 1
       Date2.Cells(drnlgn2, "A").Value = Date1.Cells(i, "A").Value
    End If
Next i
End Sub

Salut,

Ça ne fonctionne pas , je comprends pas trop ton code sachant que je n’ai rien sur la feuille deux pourquoi compter les lignes de la feuille 2?

Puis tu ne définis pas drnlgn c’est normal ?!

Merci beaucoup,

Hugo

Bonjour,

Essayer ce code

Sub copie()
    Dim cell As Range, cell1 As Range, lignes_à_copier As Range

    With Sheets("Sheet1")
        Set cell = .Columns("A").Find(.Range("C1").Value)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                If lignes_à_copier Is Nothing Then Set lignes_à_copier = cell.EntireRow _
                Else Set lignes_à_copier = Union(lignes_à_copier, cell.EntireRow)
                Set cell = .Columns("A").FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With

    With Sheets("Sheet2")
        lignes_à_copier.Copy .Range("A2")
    End With
End Sub

Top ça marche avec la modify suivante en fin de code

With worksheets(« sheet1 »)

Ligne à copier.copy worksheets(« sheet2 »).Range(« A2 »)

End with

End sub

Merci beaucoup

Salut

hugo.c a écrit :

Puis tu ne définis pas drnlgn c’est normal ?!

bien sur cpas normal :il doit être drnlgn1 a la place de drnlgn

menant tu peux essayer ca

Sub test()

Set Date1 = Worksheets("Sheet1")
Set Date2 = Worksheets("Sheet2")

DateC = Date1.Range("C1")
drnlgn1 = Date1.Cells(Rows.Count, "A").End(xlUp).Row
drnlgn2 = Date2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To drnlgn1
    If Date1.Cells(i, "A").Value = DateC.Value Then
       drnlgn2 = drnlgn2 + 1
       Date2.Cells(drnlgn2, "A").Value = Date1.Cells(i, "A").Value
    End If
Next i
End Sub