Macro fonctionne plus

Bonsoir,

dans un fichier j'ai une macro qui ne fonctionne plus. Dans des copies elle fonctionne et aléatoirement elle ne fonctionne plus. Ce n'est pas moi qui l'ai ecrite j'y connais Rien. Si je joins le fichier est-ce que un expert peu y jeter un oeil? merci d'avance

avec le fichier, feuil select fich matos la macros ne fonctionne pas

erreur 1004

Débogage:

Sub test()
    impFichMatos 17
End Sub

Sub impFichMatos(num_sejour As Long)
    Dim shImpMat As Worksheet    ', shMatSej As Worksheet, shMatPla As Worksheet
    Set shImpMat = Worksheets("impress fich matos")
    '    Set shMatSej = Worksheets("matériel sur place")
    '    Set shMatPla = Worksheets("matériel séjour")
    Dim materiel As Variant, sh As Worksheet
    Dim i As Long, lig1 As Long, col1 As Long, lig2 As Long, derlig As Long, lig As Long
    Dim catArt As String, pw As String

    pw = "entrepot74"
    materiel = Array("matériel séjour", "matériel sur place")
    Application.ScreenUpdating = False
     shImpMat.Unprotect Password:=pw
    ' nettoyer
    Resize(shImpMat.Cells(Rows.Count, "B").End(xlUp).Row - 1, 4).ClearContents
    col1 = num_sejour + 2
    lig2 = 2
    For i = 0 To 1
        Set sh = Worksheets(materiel(i))
        For lig1 = 3 To sh.Cells(Rows.Count, "B").End(xlUp).Row
            If sh.Cells(lig1, col1) > 0 Then
                If i = 0 Then
                    sh.Cells(lig1, 1).Resize(1, 2).Copy shImpMat.Cells(lig2, 1)
                    sh.Cells(lig1, col1).Copy shImpMat.Cells(lig2, 3)
                    lig2 = lig2 + 1
                Else
                    catArt = sh.Cells(lig1, 1) & sh.Cells(lig1, 2)
                    derlig = shImpMat.Cells(Rows.Count, "B").End(xlUp).Row
                    For lig = 2 To derlig
                        If shImpMat.Cells(lig, 1) & shImpMat.Cells(lig, 2) = catArt Then Exit For
                    Next lig
                    If lig <= derlig Then
                        sh.Cells(lig1, col1).Copy shImpMat.Cells(lig, 4)
                    Else
                        sh.Cells(lig1, 1).Resize(1, 2).Copy shImpMat.Cells(lig, 1)
                        sh.Cells(lig1, col1).Copy shImpMat.Cells(lig, 4)
                        lig2 = lig2 + 1
                    End If
                End If
            End If
        Next lig1
    Next i
    ' trier
    shImpMat.Sort.SortFields.Clear
    shImpMat.Sort.SortFields.Add Key:=Range("A2:A500"), SortOn:=xlSortOnValues, Order:=xlAscending
    shImpMat.Sort.SortFields.Add Key:=Range("B2:B500"), SortOn:=xlSortOnValues, Order:=xlAscending
    With shImpMat.Sort
        .SetRange Range("A1:D500")
        .Header = xlYes
        .Apply
    End With

     shImpMat.Protect Password:=pw
    Application.ScreenUpdating = True
End Sub

Bonsoir,

Kelk1 ,voit pourquoi la formule fait une erreur 1004 ? merci d'avance

Bonjour,

parce que tu as enlevé shImpMat.[A2]. devant resize(...)

eric

Désolé en réalité la ligne qui pose soucis est bien:

shImpMat.[A2].Resize(shImpMat.Cells(Rows.Count, "B").End(xlUp).Row - 1, 4).ClearContents

le 'shImpMat.[A2].' en moins est une erreur lors du copier/coller dans le message.

Je joins la partie du fichier qui ne fonctionne pas. il va fonctionner 8 fois par exemple puis il plante.

Merci pour la réponse réactive

Bonjour,

La prochaine fois si tu peux mettre un fichier sans signature numérique...

Décris en détail les manips à effectuer pour avoir l'erreur stp

eric

Bonjour,

lorsque j'ouvre le dossier tout va bien, à part le fichier joint car il manque la première feuil. J'active les macro et c'est partiSi j'effectue la macro plusieurs fois avec des numéro de séjour différents , genre 1,23,43,51,12, l'erreur 1004 apparaît de façon aléatoire ( jamais beaucoup d'essais 10 maxi).

et le débogeur signal la phrase notée plus haut. Voilà j'espère que c'est assez clair. J'ai essayé le fichier sur un autre pc le résultat est le même.

yves

C'est parce que tu demandes à imprimer des feuilles vides.

Remplace la ligne par :

    derlig = shImpMat.Cells(Rows.Count, "B").End(xlUp).Row
    If derlig > 2 Then shImpMat.[A2].Resize(derlig - 1, 4).ClearContents

eric