Problème macro avec verrouillage/déverrouillage onglet

Bonjour à tous,

Je bloque sur une macro toute bête.

Ma macro copie des données d'un fichier A (Demande intervention)

Elle ouvre un fichier B (List-060 Ind A - Liste de suivi des demandes de maintenance) puis déverrouille l'onglet

Colle les données dans la colonne B à la premirère cellule vide.

Verrouille à nouveau l'onglet, sauvegarde et ferme.

Cependant, ma macro plante juste après avoir déverrouillé le fichier B.
Si je sauvegarde ce fichier B sans verrouillage, la macro fonctionne.

La commande de déverrouillage-verrouillage fonctionne en elle-même, car quand la macro plante avant de coller les données, l'onglet du fichier B est bien déverrouillé...

Je ne comprends pas...

Je vous remercie par avance pour votre aide.

Sub Envoi_email()
'
' Macro1 Macro
'
Dim ligne As Integer
Set Email = CreateObject("Outlook.application")
Dim x As Long

With Email.CreateItem(olMailItem)
.Subject = "Fiche maintenance du " & Range("F3") & " de " & Range("F5")
.To = Worksheets("Listes").Range("B2")
.Copy = Worksheets("Listes").Range("B4")
.Body = "Merci de prendre connaissance de la fiche maintenance envoyée le " & Range("F3") & " par " & Range("F5") & "." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Le fichier de synthèse a été incrémenté. Merci au porteur de décrire les actions à mener ainsi que le délai prévisionnel." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Cordialement"
.Send

End With

    Sheets("Demande intervention").Range("J1:P1").Copy
    Workbooks.Open ("N:\Bibliothèque PDF\XXX\90-Listes\List-060 Ind A - Liste de suivi des demandes de maintenance.xlsx")
    Sheets("Synthèse").Select
    ActiveSheet.Unprotect ("qb")
    x = Range("B" & Rows.Count).End(xlUp).Row + 1
    Cells(x, 2).Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    ActiveSheet.Protect ("qb")
    ActiveWorkbook.Save
    ActiveWorkbook.Close

Sheets("Demande intervention").Select
Range("F3,F5,F9,F11,F13,D15,D17,D19,D21,H15,H17,H19,H21,B25,B28,B31").Select
Selection.ClearContents
Range("F3").Select

MsgBox "Bon maintenance envoyé. Merci"

End Sub

Bonsoir Zed69, le forum,

Un essai...à tout hasard...

Sub test()
 Dim ligne As Integer
 Dim x As Long
 Dim plage
   Set Email = CreateObject("Outlook.application")
    With Email.CreateItem(olMailItem)
     .Subject = "Fiche maintenance du " & Range("F3") & " de " & Range("F5")
     .To = Worksheets("Listes").Range("B2")
     .Copy = Worksheets("Listes").Range("B4")
     .Body = "Merci de prendre connaissance de la fiche maintenance envoyée le " & Range("F3") & " par " & Range("F5") & "." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Le fichier de synthèse a été incrémenté. Merci au porteur de décrire les actions à mener ainsi que le délai prévisionnel." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Cordialement"
     .Send
    End With

   plage = ThisWorkbook.Sheets("Demande intervention").Range("J1:P1").Value
    Application.ScreenUpdating = False
     Workbooks.Open ("N:\Bibliothèque PDF\XXX\90-Listes\List-060 Ind A - Liste de suivi des demandes de maintenance.xlsx")
      With ActiveWorkbook
       With .Sheets("Synthèse")
        .Unprotect "qb"
         x = .Range("B" & Rows.Count).End(xlUp).Row + 1
        .Cells(x, 2).Resize(1, 7) = plage: Erase plage
        .Protect "qb"
       End With
      .Save
      .Close
     End With

   With Sheets("Demande intervention")
   .Range("F3,F5,F9,F11,F13,D15,D17,D19,D21,H15,H17,H19,H21,B25,B28,B31").ClearContents
   .Range("F3").Select
   End With
 MsgBox "Bon maintenance envoyé. Merci"
End Sub

Cordialement,

Malheureusement cela produit la même erreur.

Toute action après le déverouillage bug.

Re,

Tu as adapté une partie de mon code au milieu du tien, mais il y a des incohérences...

Recopie le code que je t'ai fourni dans son intégralité (donc à la place du tien)et refais l'essai, j'ai testé chez moi, cela fonctionne..(pour la recopie des données)...

Cordialement,

Hello,

Et bien avec ton code cela fonctionne.

J'ai juste corrigé la fin qui générait un bug.

   With Sheets("Demande intervention")
   .Range("F3,F5,F9,F11,F13,D15,D17,D19,D21,H15,H17,H19,H21,B25,B28,B31").ClearContents
   .Range("F3").Select

Merci beaucoup pour ton aide xorsankukai.

Par contre je ne comprends toujours pas ce qui ne fonctionnait pas avec mon code (même s'il est moins propre).

Cdlt