Discussion :

[ptitloup57]

Bonjour
J'ai un tableau sous excel 2003
Je voudrai faire une recherche d'une date (colonne) et copier la ligne qui correspond dans un autre onglet
Merci
PG

[Fvandermeulen]

Bonjour,
Voici une proposition, on considère que la liste des dates est dans la colonne A de la feuille1 et que tu indiques dans la cellule D1 la date recherchée.
La macro ballaie la plage de la colonne A pour trouver la date et copier la ligne en Valeur dans la cellule A1 de la feuill2.
J'ai supposé qu'il n'y avait qu'un date dans la liste qui répondait à la recherche, si ce n'est pas le cas, il faudra prévoir une autre boucle pour le copié.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub TestCopieDate()
 
NbLigne = Application.Subtotal(3, Sheets("sheet1").Range("a:a"))
LaDate = Sheets("sheet1").Range("d1") 'il faut noter la date recherchée dans la feuille1 cellule d1
 
 
For i = 1 To NbLigne
 
    If Cells(i, 1).Value = LaDate Then
    Cells(i, 1).EntireRow.Copy
    Sheets("sheet2").Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Copie en valeur dans A1 de la feuille2
    Exit Sub 'Sort de la boucle !seulement si une seule date possible
    End If
 
Next i
 
End Sub

Bonne continuation

[Fvandermeulen]

Salut,
Voici la version adapté si plusieurs dates répondent à la recherche, j'ai utiliser 'k' pour définir la ligne sur laquelle les valeurs sont copiées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub TestCopieDate()
 
NbLigne = Application.Subtotal(3, Sheets("sheet1").Range("a:a"))
LaDate = Sheets("sheet1").Range("d1") 'il faut noter la date recherchée dans la feuille1 cellule d1
k = 0 'k va représenter la ligne pour la copie, incrémenté si plusieurs dates correspondent à la recherche.
 
For i = 1 To NbLigne
 
    If Cells(i, 1).Value = LaDate Then
    k = k + 1
    Cells(i, 1).EntireRow.Copy
    Sheets("sheet2").Range("a" & k).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Copie en valeur dans A1 de la feuille2
    End If
 
Next i
 
Application.CutCopyMode = False
 
End Sub

Bonne continuation

[ptitloup57]

Excellent
C'est trop super et ça marche du tonnerre de dieu
Je te remercie mille fois
PG