Bonjour



J'ai bizouné mon code. J'obtiens un erreur de type 438 à la ligne et n'étant pas très bon en VBA. Je ne sais pas ou est le problème.


Code : Sélectionner tout - Visualiser dans une fenêtre à part
Ws(Cellule.Row).Copy


Voici mon code en entier:


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
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
 
 
 
Sub Liste_()
 
        Dim Ws As Worksheet
        Dim Cellule As Range
        Dim Premiere As Variant
        Dim Réponse As Integer
        Dim i As Integer
        Dim Nwb As Workbook
 
 
Réponse = MsgBox("Des éléments ont été trouvés " & Chr(10) & Chr(10) & Chr(10) & _
                "Voulez-vous afficher la liste?", vbYesNo)
 
 
 
        If Réponse = vbYes Then
 
 
 
        For Each Ws In Worksheets 'Pour toute les feuilles du classeur
 
        Set Cellule = Range("N5:N100").Find("", , , , xlByColumns, xlNext)
 
        If Not Cellule Is Nothing Then
            Premiere = Cellule.Address
 
 
 
        Do
 
 
 
        'action a faire dès que la ligne est trouvée
 
        Set Cellule = Range("N5:N100").FindNext(Cellule)
        Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere
 
            End If
 
 
        Next
 
 
            i = 0
 
        For Each Ws In Worksheets
 
            Set Cellule = Range("N5:N100").Find("", , , , xlByColumns, xlNext)
            If Not Cellule Is Nothing Then
                Premiere = Cellule.Address
 
 
                If i = 0 Then Set Nwb = Workbooks.Add
            ThisWorkbook.Sheets("Test").Visible = True
            ThisWorkbook.Sheets("Test").Copy Before:=Nwb.Sheets(1)
            ThisWorkbook.Sheets("Test").Visible = False
            Application.DisplayAlerts = False
            Nwb.Sheets(2).Delete
            Application.DisplayAlerts = True
 
 
 
                Do
 
 
                     i = i + 1
                 Ws(Cellule.Row).Copy
                 Nwb.Sheets("Test").Range("A" & i + 5).PasteSpecial Paste:=xlPasteValues
                    Set Cellule = Range("N5:N100").FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere
 
 
            End If
 
            Next
 
 
        Else
 
        Exit Sub
 
        End If
 
 
 
Application.CutCopyMode = False
 
Application.ScreenUpdating = True
 
End Sub
Est-ce possible de me donner un coup de main pour régler mon problème.


Merci