Discussion :

[floutz]

Bonjour, à tous
Etant débutant, j'aurais besoin d'un coup de main sur ma macro, car quand je l'exécute, ca bloque aux lignes 23 et 24 et je ne sais pas pourquoi...Le but de cette macro est de copier la ligne si la cellule C de cette ligne est égale à "PAL", puis dans un autre classeur qu'elle aura ouvert auparavant, d'effacer la feuille et de coller les lignes copiées. Le soucis arrive au moment ou la macro doit coller dans le classeur de destination, ca indique erreur 9 . Si vous voyer des choses pour optimiser la macro ou qu'elle tourne mieux, je suis preneur aussi! Merci

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
Sub Copie()
Dim lig As Long
Dim CD As Workbook ' classeur de destination
Dim CS As Workbook 'classeur source
 
Set CS = ThisWorkbook 'defini le classeur source
Set CD = Application.Workbooks.Open(Filename:="H:PAL.xlsm") 'defini le classeur destination
 
 
'Efface le contenu de PAL
Sheets("Maintenance_PAL").Select
Range("A2:J18").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("A1").Select
 
'Active le fichier Maintenance
CS.Activate
' Copie les lignes ou la colonne C =PAL et les collles dans CD
With Sheets("Maintenance")
        For lig = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
        If .Cells(lig, "C") = "PAL" Then
            .Range("A" & lig & ":H" & lig).Copy _
            Destination:=CD.Sheets("Maintenance_PAL").Cells(Sheets("Maintenance_PAL").Cells(Rows.Count, "A2").End(xlUp).Row + 1, 1)
 
        End If
    Next lig
End With
CS.Activate
End Sub

[Franc]

Salut, ne faudrait-il pas ajouter la barre oblique au chemin destination ? "H:\PAL.xlsm"

[Tête de chat]

Bonjour,

beaucoup de select - par définition inutiles - dans tout ça...

Essaye ça :

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
Sub Copie()
Dim lig As Long, LigMax As Long, Ldest As Long
Dim CD As Workbook ' classeur de destination
 
Set CD = Application.Workbooks.Open(Filename:="H:PAL.xlsm") 'définit le classeur destination
 
'Efface le contenu de PAL
With CD.Sheets("Maintenance_PAL").Range("A2")
    .Range(.Cells, .SpecialCells(xlLastCell)).ClearContents
End With
Ldest = 2
' Copie les lignes où la colonne C =PAL et les colle dans CD
With ThisWorkbook.Sheets("Maintenance")
    LigMax = .Cells(Rows.Count, "C").End(xlUp).Row
    For lig = 2 To LigMax
        If .Cells(lig, "C") = "PAL" Then
            .Range("A" & lig & ":H" & lig).Copy _
            Destination:=CD.Sheets("Maintenance_PAL").Cells(Ldest, 1)
            Ldest = Ldest + 1
        End If
    Next lig
End With
ThisWorkbook.Activate
End Sub

Inutile de mon point de vue d'instancier CS=Thisworkbook puisque ThisWorkBook est déjà un objet très honorable.
J'ai un peu simplifié le clearcontents ; attention il est un peu plus large que celui d'origine, peut être à retoucher
J'ai instancié une variable pour la dernière ligne de départ; inutile de refaire le même end à chaque boucle
J'ai instancié une variable pour la ligne de destination ; inutile de lancer un end à chaque fois puisqu'on maitrise parfaitement le remplissage

[floutz]

Merci beaucoup, ca fonctionne!