Sélection de plage selon données d'inputbox

Version imprimable

Bonjour à tous !
Après avoir éclusé le forum, je ne m'en sors toujours pas - et étant débutant et autodidacte, je sens bien qu'il me manque une info et j'aurais bien besoin de vos lumières d'experts.
Voici mon problème.

J'ai un tableau à cinq colonnes : Nom - Date - Montant - Référence - Dispatch

Dans ce tableau, les données sont classées par date puis, pour chaque date, par référence. Le nombre de lignes par date n'est pas fixe.
Je voudrais une macro qui lance une inputbox dans laquelle on rentrerait une date, puis qui sélectionnerait toutes les lignes correspondant à la date saisie et les copierait dans un feuillet à part.
Pour l'instant j'ai une macro, mais qui ne sélectionne / copie-colle que la dernière ligne à la date voulue, or j'aurais besoin qu'elle les sélectionne toutes...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim i As Integer Dim nb_lig As Integer Dim ds As Date nb_lig = Range("A" & Rows.Count).End(xlUp).Row ds = InputBox("Date souhaitée") For i = 2 To nb_lig Set zone = Range("A" & i & ":E" & i) If Cells(i, 2) = ds Then Range("A" & i & ":E" & i).Copy Next Sheets.Add After:=ActiveSheet ActiveSheet.Paste End Sub
Comment pourrais-je faire ?
Merci à tous

Bonjour à tous

je me suis permis d'ajouter quelques variables
je te propose une affectation de nb_lig un peu plus courte (que perso j'utilise très souvent) même si la tienne fonctionne très bien

voici donc une version de ton code qui fonctionne:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub test()
 
    Dim i As Integer
    Dim nb_lig As Integer
    Dim ds As Date
    Dim Der_Lign_Sel As Long
    Dim Deb_Lign_Sel As Long
 
 
'    nb_lig1 = Range("A" & Rows.Count).End(xlUp).Row
    nb_lig = [A1].End(xlDown).Row
 
    ds = InputBox("Date souhaitée")
    Deb_Lign_Sel = 0
 
    For i = 2 To nb_lig
        If Deb_Lign_Sel = 0 Then
            If Cells(i, 2).Value = ds Then
                Deb_Lign_Sel = i
            End If
        Else
            If Cells(i, 2).Value <> ds And Cells(i - 1, 2).Value = ds Then
                Der_Lign_Sel = i - 1
            End If
        End If
    Next
 
    Range(Cells(Deb_Lign_Sel, 1), Cells(Der_Lign_Sel, 5)).Copy
 
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
 
End Sub

il y a une gestion de ta feuille2 à faire
et moi pour une gestion plus simple de l'affaire je serais passé par un tableau en mémoire ou par un dictionnaire

si tu as besoin de plus d'explication n'hésites pas

A bientôt

Bonjour,

Autre solution en passant par un filtre

Code:

1
2
3
4
5
6
7
8
9
    Dim i As Long, NbVal As Long, nb_lig As Long
    Dim ds As Date
    nb_lig = Range("A" & Rows.Count).End(xlUp).Row
    ds = InputBox("Date souhaitée")
    ActiveSheet.Range("A1:E" & nb_lig).AutoFilter Field:=2, Criteria1:=ds
    NbVal = Range("_FilterDataBase").Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1
    Range("_FilterDataBase").Resize(, 5).SpecialCells(xlCellTypeVisible).Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

Cdlt

Citation:
Envoyé par Igloobel
Bonjour à tous

je me suis permis d'ajouter quelques variables
je te propose une affectation de nb_lig un peu plus courte (que perso j'utilise très souvent) même si la tienne fonctionne très bien

voici donc une version de ton code qui fonctionne:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 Sub test() Dim i As Integer Dim nb_lig As Integer Dim ds As Date Dim Der_Lign_Sel As Long Dim Deb_Lign_Sel As Long ' nb_lig1 = Range("A" & Rows.Count).End(xlUp).Row nb_lig = [A1].End(xlDown).Row ds = InputBox("Date souhaitée") Deb_Lign_Sel = 0 For i = 2 To nb_lig If Deb_Lign_Sel = 0 Then If Cells(i, 2).Value = ds Then Deb_Lign_Sel = i End If Else If Cells(i, 2).Value <> ds And Cells(i - 1, 2).Value = ds Then Der_Lign_Sel = i - 1 End If End If Next Range(Cells(Deb_Lign_Sel, 1), Cells(Der_Lign_Sel, 5)).Copy Sheets.Add After:=ActiveSheet ActiveSheet.Paste End Sub
il y a une gestion de ta feuille2 à faire
et moi pour une gestion plus simple de l'affaire je serais passé par un tableau en mémoire ou par un dictionnaire

si tu as besoin de plus d'explication n'hésites pas

A bientôt
Merveilleux, ça fonctionne nickel ! Trop, trop bien. Et au passage j'ai appris de nouvelles fonctions que je ne connaissais pas.

Merci à tous les deux et très bonne journée à vous !