Re bonjour, oui je sait, je poste bcp, mais je voit que je progresse, j'arrive a trouver quelque solution seul maintenant, bien qu'il faille m'indiquer un peut la route a suivre
Bon voila mon nouveau probleme, j'ai une feuille excel ou je peut rentrer deux dates, et j'aimerais pouvoir ( on est toujours dans le mm cas que tout mes autres postes) trouver toutes les dates entre ces deux dates pour ensuite copier les lignes ou ces dates sont présentes.
Si qqn aurrait un exemple d'algo, voici mon code actuel :
Simplement, il ne me copie que les lignes ou est présentes la date1
Code vba : 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
21
22
23
24
25
26
27
28
29
30
31
32
33 Set date1 = .Range("H10") Set date2 = .Range("K10") End With Workbooks(nomfichier).Activate With Sheets(nomfeuille) Range("B:B").NumberFormat = "ddmmyyyy" dl = .Range("a" & Rows.Count).End(xlUp).Row Set a = .Range("B1:B" & dl).Find(date1) Set c = .Range("A1:A" & dl).Find(nomjournal) 'Set b = .Range("B1:B" & dl).Find(date2) If date1 <> "" Or date2 <> "" Then Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = "Ecriture" irow = 0 irow2 = 1 firstaddress = a.Address For x = 1 To dl - 1 irow = irow + 1 'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement Application.ScreenUpdating = False Worksheets(nomfeuille).Select If c <> "***" Then 'copie des lignes concerner Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = c.EntireRow.Value irow2 = irow2 + 1 Sheets("Ecriture").Select End If Set a = .Range("b1:b" & dl).FindNext(a) Set c = .Range("A" & c.Row, "A" & dl).Find(nomjournal) If a Is Nothing Or a.Address = firstaddress Then Exit For End If Next x
Partager