Discussion :

[Master_x_99]

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

[Philippe Tulliez]

Bonjour,
En parcourant rapidement votre code, je vois que la variable objet ws est un objet Worksheet donc l'instruction Ws.Copy pourrait éventuellement fonctionner mais certainement pas Ws(Cellule.Row).Copy

[Master_x_99]

Merci de votre réponse.


Alors si je voudrais coller la ligne en entier que le find a trouvé. Je devrais coder comment?

[Philippe Tulliez]

Bonjour,
Je suppose que vous voulez copier la ligne entière de la cellule trouvée et ensuite coller cette plage à un autre endroit.
Le problème c'est qu'en copiant la ligne entière, on ne peux coller cette plage qu'à partir de la première colonne d'une feuille quelconque mais sans doute voulez-vous dire la ligne complète d'une certaine liste.

Voici un exemple simple qui copie la ligne complète (soit 16384 cellules) de la cellule trouvée dans la plage E1:E10 de la feuille nommée Feuil3 en la collant dans la feuille nommée Feuil2 à partir de la cellule A20

Code :

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

1
2
3
4
5
6
7
8
Sub t()
  Dim c As Range
  Dim r As Range
  Set r = ThisWorkbook.Worksheets("Feuil3").Range("E1:E10")
  Set c = r.Find(What:="toto")
  c.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Feuil2").Range("A20")
  Set c = Nothing: Set r = Nothing
End Sub

[Master_x_99]

Finalement résolu:

Voici le code

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
Sub Liste_()
 
 
Dim Ws As Worksheet
Dim Cellule As Range
Dim Premiere As Variant
Dim i As Integer
Dim Nwb As Workbook
Dim Feuille As Object
 
If MsgBox("Des éléments ont été trouvés " & Chr(10) & Chr(10) & Chr(10) & _
                "Voulez-vous afficher la liste?", vbYesNo, "Afficher les éléments") = vbYes Then
 
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
 
        Set Cellule = Ws.Range("N5:N100").Find("", , , , xlByColumns, xlNext)
 
        If Not Cellule Is Nothing Then
            Premiere = Cellule.Address
 
            If i = 0 Then Set Nwb = Workbooks.Add
 
            With ThisWorkbook.Sheets("Test")
                .Visible = True
                .Copy Before:=Nwb.Sheets(1)
                .Visible = False
            End With
 
            Application.DisplayAlerts = False
 
            For Each Feuille In Sheets
            If Feuille.Name <> "Test" Then
            Feuille.Delete
            End If
 
            Next Feuille
            Application.DisplayAlerts = True
 
 
 
            Do
                i = i + 1
 
                Ws.Range(Cellule.Address).EntireRow.Copy
                Nwb.Sheets("Test").Range("A" & i + 4).PasteSpecial Paste:=xlPasteValues
 
                Set Cellule = Ws.Range("N5:N100").FindNext(Cellule)
            Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere
 
        End If
 
    Next Ws
 
    Application.CutCopyMode = False
End If
Application.ScreenUpdating = True
End Sub