Discussion :

[lilp1]

Bonjour, j'aimerais copier certaines lignes en fonctions de 2 conditions, voici le code que j'ai entre pour le moment :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    Set n = .Range("B1:B" & dl).Find(date1)
    Set c = .Range("A1:A" & dl).Find(nomjournal)
    'Set b = .Range("b" & a.Row, "b" & dl).Find(date2)
    If date1 <> "" Or date2 <> "" Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        firstaddress = n.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 Not n Is Nothing And c <> "***" Then
                    'copie des lignes concerner
                    Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = n.EntireRow.Value
                    irow2 = irow2 + 1
                    Sheets("Ecriture").Select
                End If
            Set n = .Range("b1:b" & dl).FindNext(n)
            'Set c = .Range("a1:a" & dl).FindNext(nomjournal)
            Set c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
            If n Is Nothing Or n.Address = firstaddress Then
                Exit For
            End If
            'Set a = .Range("B" & a.Row, dl).Find(date1)
        Next x
    Else
        Set c = .Range("A1:A" & dl).Find(nomjournal)
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
            If c <> "***" Then
                'création d'une nouvelle feuille et on l'a renomme
                firstaddress = c.Address
                '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 c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
        Next x
    End If

Simplement, il me copie pas quand les deux conditions sont juste, mais quand l'une ou l'autre est juste, or j'ai bien mit un 'and' et non un 'or' dans mon test 'if'.

[casefayere]

Bonjour Lilp, re le forum,

mais quand l'une ou l'autre est juste, or j'ai bien mit un 'and' et non un 'or' dans mon test 'if'.

je suis peut-etre miro mais ce que je vois

Code :

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

 If date1 <> "" Or date2 <> "" Then

me laisse sceptique

[DeaD78]

Bonjour à tous,

Je crois que lilp1 doit parler de

Code :

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

If Not n Is Nothing And c <> "***" Then

sinon c'est vrai que c'est louche

D'ailleurs qu'entends-tu par

Code :

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

c <> "***"

? Est-ce c différent de "quelque chose" ? Cela reviendrait donc à dire If c Is Nothing non ?

Peut-être pourrais-tu tester comme cela. De plus, essaie d'imbriquer les 2 conditions :

Code :

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

1
2
3
4
If Not n Is Nothing Then
    If c <> "***"  Then
    End If
End If

A+

[lilp1]

Oui cette ligne c'est bien un 'or', mais je ne teste pas encore la variable 'date2', je peut supprimer cette ligne pour le moment et la remplacer par

Code vba :

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

If date1 <> "" then

Je parle de la ligne :

Code vba :

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

If Not n Is Nothing And c <> "***" Then

Qui est censer rentrer dans la boucle quand n n'est pas nul et quand c est différent de ***

[lilp1]

J'ai résolut le probleme, j'avait mit :

Code vba :

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

Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = a.EntireRow.Value

Au lieux de :

Code vba :

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

Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = c.EntireRow.Value

[lilp1]

Enfaite le pbrs n'est pas du tout résolut, je n'avait pas fait attention, mais il ne tient pas du tout compte de ma date, il copie quelque soit la date. Mon test 'if' ac la date et la valeur de 'c' ne marche que pour la valeur de 'c'

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
dl = .Range("a" & Rows.Count).End(xlUp).Row
    Set a = .Range("B1:B" & dl).Find(date1)
    'Set b = .Range("B1:B" & dl).Find(date2)
    Set c = .Range("A1:A" & dl).Find(nomjournal)
    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
                Workbooks(nomfichier).Activate
                Worksheets(nomfeuille).Select
                    If c <> "***" And myrange = a Then
                    Workbooks(classeur).Activate
                    Sheets(nomfeuil).Select
                        '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 b = .Range("b1:b" & dl).FindNext(b)
            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

Je viens de voir, qu'en faite c'est que la valeur 'c' et la valeur 'a' ne tourne pas a la mm vitesse, ma valeur 'a' prend directement la valeur rechercher celle rentrer dans une cellule, puis passe a la valeur d'aps, au lieux de commencer a la premiere ligne du document texte, ce qui fait que les valeurs de 'a' et de 'c' st ts le tps decalé

[DeaD78]

Re,

En même temps, je t'ai proposé quelque chose il y a quelques jours, tu ne l'as pas utilisé et tu as gardé ton code. Que veux-tu de plus ? Si tu veux 2 conditions, ben tu prends ce que je t'ai donné pour l'autre sujet où il y avait marqué 2 critères. Ca sert à rien de poster des sujets, d'obtenir des réponses, de marquer "Sujet Résolu" et de continuer avec ce que tu avais à la base. Enfin bref...

Tu sais, moi et les .Find, on est pas trop amis. Alors je te parle même pas des .FindNext. Comprendre ton code revient au mal de crâne assuré pour moi. En plus, tu n'as pas une seule boucle. Bref, c'est pas mon truc.

Alors soit quelqu'un d'autre t'aide soit tu reprends ce que je t'ai donné et tu essaies d'adapter. Si tu ne comprends pas tu demandes, je peux t'aider. Si t'es bloqué, pareil. Mais pour ça, il faut des détails : quelles sont les conditions, où sont-elles, que faire si oui ou si non...

Voilà, @+

[lilp1]

Ton code était :

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
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range, Valeur2 As Variant, d As Range
Dim NoLigne As Long, DerLig As Long, NoLigne2 As Long, DerLig2 As Long
    Set FL1 = Worksheets("DATA2") 'Tu travailles sur la feuille DATA2. Tu peux travailler sur 2 feuilles différentes si tu veux.
    NoLigne = 1 'Variable de ligne
    Do
        If Not Cells(NoLigne, 4) = "" Then
            Valeur = Cells(NoLigne, 4) 'Valeur recherchée en 1er : elle est en D1 puis D2, D3 etc...
            Valeur2 = Cells(NoLigne, 3) 'Valeur2 recherchée en 2eme : elle est en C1 puis C2...
            Do
                With FL1.Range("D" & NoLigne + 1, [D65536].End(xlUp)) 'Dans la colonne D jusqu'à la dernière cellule non vide
                    DerLig = 0 'Initialisation dernière ligne
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole) 'Le .Find avec Valeur
                    If Not c Is Nothing Then 'Si valeur trouvée
                        If c.Row > NoLigne Then 'Si valeur trouvée autre que valeur de départ
 
                            With FL1.Range("C" & NoLigne + 1, [C65536].End(xlUp)) 'Dans la colonne C jusqu'à la dernière cellule non vide
                            Set d = .Find(Valeur2, LookIn:=xlValues, LookAt:=xlWhole) 'Le .Find avec Valeur2
                            If Not d Is Nothing Then 'Si valeur2 trouvée
 
                                DerLig = c.Row 'Dernière ligne devient celle de la valeur (la 1ère) trouvée
                                c.EntireRow.Delete 'Effacement de cette ligne
 
                            End If
                            End With
                        End If
                    End If
                    Set c = Nothing 'Et on recommence !
                End With
            Loop While DerLig > NoLigne 'Tant que Dernière Ligne > Ligne
        End If
        NoLigne = NoLigne + 1 'Incrémentation
    Loop While NoLigne < FL1.Range("D65536").End(xlUp).Row 'On continue jusqu'à la dernière ligne

Mais le probleme est que j'ai été completement imcapable de l'adapter a mon cas, et j'ai bcp de mal a le comprendre.
De plus, j'ai besoin de trouver les dates qui sont comprises entre mes 2 dates et de copier ces dates la quand ds la colonne "a" il n'y a pas "***"

[DeaD78]

Ok, tâchons de l'adapter ensemble. Donne-moi quelques précisions plus exactes sur la manière de faire.

1) Quel est la première valeur à rechercher ? Où se trouve-t-elle si ce n'est pas donné en dur ? Où la recherche-t-on ? Quelle est sa forme ? Est-ce toujours la même ?
2) Mêmes questions avec la deuxième valeur ?
3) Que fait-on EXACTEMENT lorsque l'on trouve la combinaison des 2 valeurs ? Explicite bien ici :
- Que doit-on copier ? Des dates comprises entre les 2 valeurs recherchées si j'ai bien compris. Supposons que la Val1 soit trouvée en ligne 20 et la Val2 en ligne 30. Doit-on copier les lignes 21 à 29 comprises ou doit-on refaire une recherche sur tout le document pour trouver les dates comprises entre Val1 et Val2 ? D'ailleurs, si on doit refaire une recherche ici, pourquoi faire une recherche à la base ? Bref, explique ce qu'il faut copier.
- Où doit-on copier ?
- C'est quoi l'histoire de "***" ? Est-ce une condition ?

Bref, donne-nous toutes les billes, ça ira mieux, ça sera beaucoup plus rapide etc.

[lilp1]

On doit d'abord rechercher la valeur c, qui est présente dans la colonne 'a', et on doit chercher quand ds la ligne il n'y a pas *** a la colonne 'a', en gros dans la colonne 'a' j'ai soit '***' pour plein de types de pieces, soit je peut avoir des numeros, des caracteres, donc je doit chercher quand ds la colonne 'a' il n'y a pas ***.
Ensuite, je doit chercher dans la colonne 'b' les dates qui sont comprises entre mes deux dates, que j'ai recuperer d'une feuille et que je stocke sous 'date1' et 'date2'.
Quand on trouve une ligne ou dans la colone 'a' il n'y a pas *** et que dans la colone 'b' la date est comprise entre mes deux dates, je doit copier cette ligne sur une nouvelle feuille. Pour copier une ligne, il faut que dans la colonne 'a' il n'y est pas *** (ce sont juste des étoiles, je ne sait pas pkr, c de la comptabilite lol, j'espere que c pas comptable sinon dsl) et que la date dans la colonne 'b' soit comprises entre mes 2 dates, il faut que les deux conditions soit remplit pour copier la ligne.
On doit copier ces lignes dans une nouvelle feuille, dans le mm classeur quand dans lequel j'ai ouvert mon fichier texte a savoir le nom de la variable de se classeur est 'classeur'(car a la fin de la maccro je m'occupe de copier cette feuille ds un autre classeur).
Jpense que c'est bon la.

[DeaD78]

Bon, prenons les choses dans l'ordre :

On doit d'abord rechercher la valeur c, qui est présente dans la colonne 'a', et on doit chercher quand ds la ligne il n'y a pas *** a la colonne 'a', en gros dans la colonne 'a' j'ai soit '***' pour plein de types de pieces, soit je peut avoir des numeros, des caracteres, donc je doit chercher quand ds la colonne 'a' il n'y a pas ***.

Bon, là, c'est pas compliqué :

Code :

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

1
2
3
4
5
For i = 1 To Range("A1").End(xlDown).Row 'Disons qu'on commence en ligne 1
    If Cells(i, 1).Value <> "***" Then
    'Le reste
    End If
Next

Passons à la suite : d'où viennent tes 2 dates ? Comment sont-elles déclarées ? Type String ou Date ?

PS : d'après tes explications, autant ne pas passer par des .Find

EDIT : Ok, j'ai mal lu, je sais d'où viennent les deux dates. Mais est-ce que ce sont des String ?

[lilp1]

Mes deux dates sont au format 'range'. Par contre le code que tu m'a filer

Code vba :

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

1
2
3
4
5
For i = 1 To Range("A1").End(xlDown).Row 'Disons qu'on commence en ligne 1
    If Cells(i, 1).Value <> "***" Then
    'Le reste
    End If
Next

C'est peut etre con, mais je le cale a la place de quoi dans mon code?

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
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
105
106
107
108
109
110
111
Sub OuvrirLeFichier()
Dim nomfeuille As String, Ligne As Long, fichier1 As String, texte As String, _
tableau() As Long, i As Long, compteur As Long, a As Range, x As Long, dl As Long, ir As Long, _
firstaddress As String, nomfeuille1 As String, nomjournal As String, irow As Long, ouvert As Boolean, _
nomfichier As String, irow2 As Long, date1 As Range, date2 As Range, b As Range, c As Range, date3 As Range
ouvert = 0
    '2 = Texte
    '1 = Montant
    '4 = Date
    Workbooks.OpenText Filename:=LeFichierAOuvrir, FieldInfo:=Array( _
        Array(0, 2), Array(3, 4), Array(11, 2), Array(13, 2), Array(30, 2), Array(31, 2), _
        Array(48, 2), Array(83, 2), Array(118, 2), Array(121, 4), Array(129, 2), Array(130, 1), _
        Array(150, 2), Array(151, 2), Array(159, 2), Array(162, 2), Array(172, 2), Array(175, 2), _
        Array(195, 2), Array(215, 2), Array(218, 2), Array(220, 2), Array(222, 2), Array(257, 4), _
        Array(265, 4), Array(273, 2), Array(276, 2), Array(293, 4), Array(301, 2), Array(304, 2), _
        Array(324, 2), Array(344, 2), Array(347, 2), Array(350, 2), Array(385, 2), Array(386, 2), _
        Array(389, 2), Array(392, 2), Array(395, 2), Array(412, 2), Array(429, 2), Array(446, 4), _
        Array(454, 4), Array(462, 4), Array(470, 2), Array(505, 9), Array(515, 2), Array(532, 2), _
        Array(562, 2), Array(592, 2), Array(622, 2), Array(652, 2), Array(682, 2), Array(712, 2), _
        Array(742, 2), Array(772, 2), Array(802, 2), Array(832, 2), Array(835, 2), Array(838, 2), _
        Array(841, 2), Array(844, 2), Array(864, 2), Array(884, 2), Array(904, 2), Array(924, 2), _
        Array(932, 2), Array(933, 2), Array(934, 2), Array(937, 2), Array(957, 2), Array(977, 2), _
        Array(997, 2), Array(1005, 2), Array(1013, 2), Array(1018, 2), Array(1019, 2), Array(1020, 2), _
        Array(1023, 2), Array(1040, 2), Array(1057, 2), Array(1074, 2), Array(1091, 2), Array(1126, 2), _
        Array(1129, 2), Array(1139, 2), Array(1142, 2), Array(1159, 2), Array(1176, 2), Array(1177, 2), _
        Array(1185, 2), Array(1193, 2), Array(1201, 2), Array(1236, 2), Array(1237, 2), Array(1238, 2), _
        Array(1241, 2), Array(1249, 2), Array(1266, 2), Array(1269, 2), Array(1277, 2), Array(1280, 2))
ouvert = 1  'si le fichier est ouvert sous forme de classeur XLS
    Range("B:B,J:J,X:X,Y:Y,AB:AB,AP:AP,AQ:AQ,AR:AR").NumberFormat = "ddmmyyyy"
    With Range("L:L,R:R,S:S,BJ:BJ,BK:BK,BL:BL,BM:BM")
        .HorizontalAlignment = xlRight
        .NumberFormat = "0.00"
    End With
    'enregistrement du nom de la feuille active dans une variable
    nomfeuille = ActiveSheet.Name
    nomfichier = ActiveWorkbook.Name
    'recherche de la valeur '***' dans la colonne 'a'
    nomjournal = "***"
    Workbooks(classeur).Activate
    With Sheets(nomfeuil)
        'on recupere les dates rentrer dans le formulaire
        Set date1 = .Range("H10")
        Set date2 = .Range("K10")
    End With
    Workbooks(nomfichier).Activate
    With Sheets(nomfeuille)
    'on formate la colonne 'b' au format date
    Range("B:B").NumberFormat = "ddmmyyyy"
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    Set a = .Range("B1:B" & dl).Find(date1)
    'Set b = .Range("B1:B" & dl).Find(date2)
    Set c = .Range("A1:A" & dl).Find(nomjournal)
    NoLigne = 1
    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
            Workbooks(nomfichier).Activate
            Worksheets(nomfeuille).Select
                If c <> "***" And myrange = a Then
                    Workbooks(classeur).Activate
                    Sheets(nomfeuil).Select
                    '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("b" & a.Row, "b" & dl).Find(a)
            'Set b = .Range("b" & b.row, "b" & dl).Find(b)
            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
    Else
        Set c = .Range("A1:A" & dl).Find(nomjournal)
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
            If c <> "***" Then
                'création d'une nouvelle feuille et on l'a renomme
                firstaddress = c.Address
                '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 c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
        Next x
    End If
    Call LigneChampsEcrGen
    End With
    'copie de la feuille du nouveau classeur dans l'ancien et suppresion du nouveau
    Application.DisplayAlerts = False
    Sheets("Ecriture").Select
    Sheets("Ecriture").Copy After:=Workbooks("Essai.xls").Sheets(1)
    Windows(nomfichier).Close
    Windows("Essai.xls").Activate
    Exit Sub
End Sub

Bon dsl, mais ma journée est finit, et l'alim de mon pc domestique est grillée, donc je ne pourrais pas revenir avant demain, si on m'envoit pas sur autre chose, j'espere pas, car sa fait 3semaines quasiment que je suis sur cette app et j'aimerais bien la finir mdr. Bonne soirée et encore merci pour ton aide, j'espere a demain, pour une belle journée et plein de solutions

[lilp1]

Voici comment j'ai integrer le code que tu m'a donner hier, jpense que je l'ai mit au bon endroit?

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
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
Sub OuvrirLeFichier()
Dim nomfeuille As String, Ligne As Long, fichier1 As String, texte As String, _
tableau() As Long, i As Long, compteur As Long, a As Range, x As Long, dl As Long, ir As Long, _
firstaddress As String, nomfeuille1 As String, nomjournal As String, irow As Long, ouvert As Boolean, _
nomfichier As String, irow2 As Long, date1 As Range, date2 As Range, b As Range, c As Range, date3 As Range
ouvert = 0
    '2 = Texte
    '1 = Montant
    '4 = Date
    Workbooks.OpenText Filename:=LeFichierAOuvrir, FieldInfo:=Array( _
        Array(0, 2), Array(3, 4), Array(11, 2), Array(13, 2), Array(30, 2), Array(31, 2), _
        Array(48, 2), Array(83, 2), Array(118, 2), Array(121, 4), Array(129, 2), Array(130, 1), _
        Array(150, 2), Array(151, 2), Array(159, 2), Array(162, 2), Array(172, 2), Array(175, 2), _
        Array(195, 2), Array(215, 2), Array(218, 2), Array(220, 2), Array(222, 2), Array(257, 4), _
        Array(265, 4), Array(273, 2), Array(276, 2), Array(293, 4), Array(301, 2), Array(304, 2), _
        Array(324, 2), Array(344, 2), Array(347, 2), Array(350, 2), Array(385, 2), Array(386, 2), _
        Array(389, 2), Array(392, 2), Array(395, 2), Array(412, 2), Array(429, 2), Array(446, 4), _
        Array(454, 4), Array(462, 4), Array(470, 2), Array(505, 9), Array(515, 2), Array(532, 2), _
        Array(562, 2), Array(592, 2), Array(622, 2), Array(652, 2), Array(682, 2), Array(712, 2), _
        Array(742, 2), Array(772, 2), Array(802, 2), Array(832, 2), Array(835, 2), Array(838, 2), _
        Array(841, 2), Array(844, 2), Array(864, 2), Array(884, 2), Array(904, 2), Array(924, 2), _
        Array(932, 2), Array(933, 2), Array(934, 2), Array(937, 2), Array(957, 2), Array(977, 2), _
        Array(997, 2), Array(1005, 2), Array(1013, 2), Array(1018, 2), Array(1019, 2), Array(1020, 2), _
        Array(1023, 2), Array(1040, 2), Array(1057, 2), Array(1074, 2), Array(1091, 2), Array(1126, 2), _
        Array(1129, 2), Array(1139, 2), Array(1142, 2), Array(1159, 2), Array(1176, 2), Array(1177, 2), _
        Array(1185, 2), Array(1193, 2), Array(1201, 2), Array(1236, 2), Array(1237, 2), Array(1238, 2), _
        Array(1241, 2), Array(1249, 2), Array(1266, 2), Array(1269, 2), Array(1277, 2), Array(1280, 2))
ouvert = 1  'si le fichier est ouvert sous forme de classeur XLS
    Range("B:B,J:J,X:X,Y:Y,AB:AB,AP:AP,AQ:AQ,AR:AR").NumberFormat = "ddmmyyyy"
    With Range("L:L,R:R,S:S,BJ:BJ,BK:BK,BL:BL,BM:BM")
        .HorizontalAlignment = xlRight
        .NumberFormat = "0.00"
    End With
    'enregistrement du nom de la feuille active dans une variable
    nomfeuille = ActiveSheet.Name
    nomfichier = ActiveWorkbook.Name
    'recherche de la valeur '***' dans la colonne 'a'
    nomjournal = "***"
    Workbooks(classeur).Activate
    With Sheets(nomfeuil)
        'on recupere les dates rentrer dans le formulaire
        Set date1 = .Range("H10")
        Set date2 = .Range("K10")
    End With
    Workbooks(nomfichier).Activate
    With Sheets(nomfeuille)
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    'on formate la colonne 'b' au format date
    Range("B:B").NumberFormat = "ddmmyyyy"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Ecriture"
    irow = 0
    For i = 1 To dl 'Disons qu'on commence en ligne 1
        Workbooks(nomfichier).Activate
        Sheets(nomfeuille).Select
        If Cells(i, 1).Value <> "***" Then
            irow = irow + 1
            Workbooks(nomfichier).Sheets("Ecriture").Cells(irow, 1).Columns("A:BP").Value = Workbooks(nomfichier).Sheets(nomfeuille).Cells(i, 1).EntireRow.Value
            'Le reste
        End If
    Next
    Call LigneChampsEcrGen
    End With
    'copie de la feuille du nouveau classeur dans l'ancien et suppresion du nouveau
    Application.DisplayAlerts = False
    Sheets("Ecriture").Select
    Sheets("Ecriture").Copy After:=Workbooks("Essai.xls").Sheets(1)
    Windows(nomfichier).Close
    Windows("Essai.xls").Activate
    Exit Sub
End Sub

Il reste, encore le test des dates

J'ai rajouter le test des dates :

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
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
Sub OuvrirLeFichier()
Dim nomfeuille As String, Ligne As Long, fichier1 As String, texte As String, _
tableau() As Long, i As Long, compteur As Long, a As Range, x As Long, dl As Long, ir As Long, _
firstaddress As String, nomfeuille1 As String, nomjournal As String, irow As Long, ouvert As Boolean, _
nomfichier As String, irow2 As Long, date1 As Date, date2 As Date, b As Range, c As Range, date3 As Range
ouvert = 0
    '2 = Texte
    '1 = Montant
    '4 = Date
    Workbooks.OpenText Filename:=LeFichierAOuvrir, FieldInfo:=Array( _
        Array(0, 2), Array(3, 4), Array(11, 2), Array(13, 2), Array(30, 2), Array(31, 2), _
        Array(48, 2), Array(83, 2), Array(118, 2), Array(121, 4), Array(129, 2), Array(130, 1), _
        Array(150, 2), Array(151, 2), Array(159, 2), Array(162, 2), Array(172, 2), Array(175, 2), _
        Array(195, 2), Array(215, 2), Array(218, 2), Array(220, 2), Array(222, 2), Array(257, 4), _
        Array(265, 4), Array(273, 2), Array(276, 2), Array(293, 4), Array(301, 2), Array(304, 2), _
        Array(324, 2), Array(344, 2), Array(347, 2), Array(350, 2), Array(385, 2), Array(386, 2), _
        Array(389, 2), Array(392, 2), Array(395, 2), Array(412, 2), Array(429, 2), Array(446, 4), _
        Array(454, 4), Array(462, 4), Array(470, 2), Array(505, 9), Array(515, 2), Array(532, 2), _
        Array(562, 2), Array(592, 2), Array(622, 2), Array(652, 2), Array(682, 2), Array(712, 2), _
        Array(742, 2), Array(772, 2), Array(802, 2), Array(832, 2), Array(835, 2), Array(838, 2), _
        Array(841, 2), Array(844, 2), Array(864, 2), Array(884, 2), Array(904, 2), Array(924, 2), _
        Array(932, 2), Array(933, 2), Array(934, 2), Array(937, 2), Array(957, 2), Array(977, 2), _
        Array(997, 2), Array(1005, 2), Array(1013, 2), Array(1018, 2), Array(1019, 2), Array(1020, 2), _
        Array(1023, 2), Array(1040, 2), Array(1057, 2), Array(1074, 2), Array(1091, 2), Array(1126, 2), _
        Array(1129, 2), Array(1139, 2), Array(1142, 2), Array(1159, 2), Array(1176, 2), Array(1177, 2), _
        Array(1185, 2), Array(1193, 2), Array(1201, 2), Array(1236, 2), Array(1237, 2), Array(1238, 2), _
        Array(1241, 2), Array(1249, 2), Array(1266, 2), Array(1269, 2), Array(1277, 2), Array(1280, 2))
ouvert = 1  'si le fichier est ouvert sous forme de classeur XLS
    Range("J:J,X:X,Y:Y,AB:AB,AP:AP,AQ:AQ,AR:AR").NumberFormat = "ddmmyyyy"
    Range("B:N").NumberFormat = "dd/mm/yyyy"
    With Range("L:L,R:R,S:S,BJ:BJ,BK:BK,BL:BL,BM:BM")
        .HorizontalAlignment = xlRight
        .NumberFormat = "0.00"
    End With
    'enregistrement du nom de la feuille active dans une variable
    nomfeuille = ActiveSheet.Name
    nomfichier = ActiveWorkbook.Name
    'recherche de la valeur '***' dans la colonne 'a'
    'nomjournal = "***"
    Workbooks(classeur).Activate
    With Sheets(nomfeuil)
        'on recupere les dates rentrer dans le formulaire
        date1 = Cells(10, 8)
        date2 = Cells(10, 11)
    End With
    Workbooks(nomfichier).Activate
    With Sheets(nomfeuille)
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    'on formate la colonne 'b' au format date
    Range("B:B").NumberFormat = "dd/mm/yyyy"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Ecriture"
    irow = 0
    For i = 1 To dl 'Disons qu'on commence en ligne 1
        Workbooks(nomfichier).Activate
        Sheets(nomfeuille).Select
        If Cells(i, 1).Value <> "***" Then
            If date1 <= Cells(i, 2).Value And Cells(i, 2) <= date2 Then
            irow = irow + 1
            Workbooks(nomfichier).Sheets("Ecriture").Cells(irow, 1).Columns("A:BP").Value = Workbooks(nomfichier).Sheets(nomfeuille).Cells(i, 1).EntireRow.Value
            'Le reste
            End If
        End If
    Next
    Call LigneChampsEcrGen
    End With
    'copie de la feuille du nouveau classeur dans l'ancien et suppresion du nouveau
    Application.DisplayAlerts = False
    Sheets("Ecriture").Select
    Sheets("Ecriture").Copy After:=Workbooks("Essai.xls").Sheets(1)
    Windows(nomfichier).Close
    Windows("Essai.xls").Activate
    Exit Sub
End Sub

C'est bon, il me copie bien les lignes ou il n'y a pas *** et dont les dates sont comprises entres les dates saisies
Merci DeaD78 pour ton aide et ta patience

[DeaD78]

Re,

Désolé pour le retard de la réponse mais j'ai été un peu occupé depuis hier, enfin...

Mais bravo, tu as bien placé la petite recherche et tu l'as bien complétée avec le test des dates

A plus tard !