VBA Excel 2003 Copier ligne sous plusieurs conditions

Version imprimable

29/01/2013, 12h00
Harreauv

VBA Excel 2003 Copier ligne sous plusieurs conditions

Bonjour,

J'ai des listes de données sur une feuille que j'aimerai pouvoir copier sur une autre feuille sous deux critères que l'utilisateur définirait sur demande (via application.inputbox ??)

Le premier critère est une date
Le deuxième critère est une valeur déjà définie dans une useform.

Je n'arrive pas à faire la sélection par date.

Quelqu'un a des pistes?

Merci
29/01/2013, 14h02
Invité
Bonjour Harreauv

Puisque c'est une date et que la saisie se fait via inputbox, il faut transformer la valeur retournée via la fonction CDate()
Code:

1 2 LaDate = InputBox("Saisissez une date") If LaDate <>"" then LaDate = CDate(LaDate)
A+
29/01/2013, 14h25
Harreauv

Merci beaucoup!!

Ya plus qu'à faire le lien avec les bonnes données!

:ccool::ccool:

En revanche la recherche en utilisant la date ne fonctionne pas...
Une idée?

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Sub Choix_date()
 
On Error Resume Next
 
' sélection des données en fonction de la date
 
Dim A As Single
Dim B As String
Dim K As Worksheet
Dim L As Worksheet
Dim M As Range
Dim FirstFound2 As String
Dim Plg1 As Range
Dim Plg2 As Range
Dim EcartNeg As Integer
 
 
A = InputBox("Date d'enregistrement?", "Choix Date") 'quelle date choisir
 
If A <> "" Then A = CDate(A)
 
 
 
 
 
 
Set K = Worksheets("Mafeuille")                          ' On travaille sur la feuille Mafeuille chèques
Set Plg1 = K.Range(K.Cells(1, 1), K.Cells(1000, 1))
 
With Plg1
 
    Set M = .Find(A, LookIn:=xlValues, LookAt:=xlPart)
        If Not (M Is Nothing) Then
            FirstFound2 = M.Address
            Do
                M.Offset(0, 15).Value = "OK !"
                Set M = .FindNext(M)
            Loop While M.Address <> FirstFound2
 
        Else
            MsgBox "Cette date n'est pas répertorié", vbOKOnly, "Mafeuille"
 
        End If
 
End With
Dim shtoto As Worksheet                             'création de la feuille temporaire pour les données sélectionnées selon la date
 
    Set shname = Sheets.Add(After:=Sheets(Sheets.Count))
 
Application.DisplayAlerts = False
 
For Each X In Sheets
If X.Name = A Then X.Delete
Next
Application.DisplayAlerts = True
 
    shname.Name = "Date_" + A 
Dim iLI As Long
 
    Dim iRE As Long
    Dim iRA As Long
 
    Dim iLO As Long
 
    Dim LI As Worksheet
    Dim LO As Worksheet
    Dim RE As Worksheet
    Dim RA As Worksheet
 
 
    Set LI = Worksheets("Mafeuille")
    Set RE = Worksheets("Date_" + A)
 
 
 
 
    iRE = 3
    iRA = 3
 
 
    For iLI = 2 To 1000
 
        If LI.Cells(iLI, 17).Text = "OK !" Then
 
            LI.Range(iLI & ":" & iLI).Copy RE.Cells(iRE, 1)
 
            iRE = iRE + 1
 
        End If
 
     Next
 
 
    For iLO = 2 To 1000
        If LO.Cells(iLO, 17).Text = "OK !" Then
 
            LO.Range(iLO & ":" & iLO).Copy RA.Cells(iRA, 1)
 
            iRA = iRA + 1
        End If
 
 
Next
End sub

29/01/2013, 15h21
Invité

Re,

Sans fichier, ça va être difficile je ne sais pas comment sont tes données ;)

A+
29/01/2013, 16h00
Harreauv

1 pièce(s) jointe(s)

Bien vu ;)

Le fichier en PJ
29/01/2013, 19h40
Invité

1 pièce(s) jointe(s)

Re,

Voici ton fichier avec le code légèrement optimisé

Je te conseille :
- l'utilisation de Option Explicit en début de module
- la déclaration de tes variables en début de Sub
- un nom explicite pour tes variables, permet de mieux s'y retrouver

A+
30/01/2013, 14h55
Harreauv

Merci Beaucoup pour ces corrections!

J'ai une erreur cependant au niveau du changement de nom

Code:

ShName.Name = ("Date " + MaDate)

Citation:

Erreur d'execution ' 13': Incompatibilité de Type.

Tu as une idée?

Merci
30/01/2013, 18h15
Invité

Bonjour Harreauv

Oups, Excel n'accepte pas des noms d'onglet avec "/"
il faut donc transformer la date en valeur texte avec des points (par exemple)

Au début de la sub

Code:

Dim sDate as string

Ensuite

Code:

sDate = Format(MaDate, "dd.mm.yyyy")

Il faut alors utiliser sDate comme variable et nom MaDate ;)

A+
31/01/2013, 18h40
Harreauv

Merci, la date passe maintenant!!

En revanche, si je lance deux fois la recherche, avec la même date, il me remet une erreur au même endroit (apparemment la suppression de la feuille du même nom ne fonctionne pas.
Tu as une idée?

Deuxième point, j'ai beau tapé une date qui existe, il me sort rien du tout sur le nouvel onglet créé.

Des idées??

Merci pour ton aide!