Macro d'une feuille à un classeur

Bonjour,

J'ai réalisé la macro ci-dessous et elle fonctionne très bien. Pour le test je ne l'ai fait que sur une feuille (sheet4) mais j'aimerais qu'elle fonctionne sur toutes les feuilles, y compris celles qui vont être créées dans le futur. Comment puis-je faire?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 1 Then
  Dim Mamessagerie As Object
  Dim Monmessage As Object
  Dim MaSignature As String

  Set Mamessagerie = CreateObject("Outlook.Application") 
  Set Monmessage = Mamessagerie.CreateItem(0) 
  Monmessage.display 
  MaSignature = Monmessage.HTMLBody 
 If Range("A3") = "d" Then 

 With Monmessage 

 .Subject = Cells(Target.Row, 1) & " - Stand Rechnungsstellung per " & Cells(1, 8) 

 .to = Cells(Target.Row, 9) 

 .CC = Cells(Target.Row, 10) 

 .HTMLBody = "Liebe Rechnungsstellungsassistentin," & "<br>" & "<br>" & "Hier der Stand der Rechnungsstellung per " & Cells(1, 8) & " für den Monat " & Cells(1, 9) & " " & Cells(1, 8) & "." & "<br>" & "<br>" & "<br>" & "<br>" & "Für Fragen stehen wir Ihnen gerne zur Verfügung." & "<br>" & MaSignature 

 .display 

 End With 

 Else With Monmessage 

 .Subject = Cells(Target.Row, 1) & " - État de facturation " & Cells(1, 8) 

 .to = Cells(Target.Row, 9) 

 .CC = Cells(Target.Row, 10) 

 .HTMLBody = "Chère assistante de facturation," & "<br>" & "<br>" & "Voici l'état de facturation au " & Cells(1, 8) & " pour le mois de " & Format(Cells(1, 8), "mmmm") & " " & Format(Cells(1, 8), "yyyy") & "." & "<br>" & "<br>" & "<br>" & "<br>" & "Avec mes meilleures salutations, " & "<br>" & MaSignature 

 .display 

 End With 

 End If 

 End If 

 End Sub

Edit modo : code à mettre entre balises avec le bouton </>

Bonjour Caroline,

Merci de mettre le code entre balises la prochaine fois SVP

Sinon votre code est à mettre dans ThisWorkbook, comme ça il fonctionnera pour toutes les feuilles

Par contre on peut légèrement optimiser le code ainsi

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Mamessagerie As Object, Monmessage As Object
  Dim MaSignature As String
'
  If Target.Column = 1 Then
    Set Mamessagerie = CreateObject("Outlook.Application")
    Set Monmessage = Mamessagerie.CreateItem(0)
    With Monmessage
      .Display
      MaSignature = .HTMLBody
      ' Mail en Allemand
      If Sh.Range("A3") = "d" Then
        .Subject = Sh.Cells(Target.Row, 1) & " - Stand Rechnungsstellung per " & Sh.Cells(1, 8)
        .to = Sh.Cells(Target.Row, 9)
        .CC = Sh.Cells(Target.Row, 10)
        .HTMLBody = "Liebe Rechnungsstellungsassistentin,<br><br>" _
          & "Hier der Stand der Rechnungsstellung per " & Sh.Cells(1, 8) _
          & " für den Monat " & Sh.Cells(1, 9) & " " & Sh.Cells(1, 8) & ".<br><br><br><br>" _
          & "Für Fragen stehen wir Ihnen gerne zur Verfügung." & "<br>" & MaSignature
      Else ' Ou en français
        .Subject = Sh.Cells(Target.Row, 1) & " - État de facturation " & Sh.Cells(1, 8)
        .to = Sh.Cells(Target.Row, 9)
        .CC = Sh.Cells(Target.Row, 10)
        .HTMLBody = "Chère assistante de facturation,<br><br>" _
          & "Voici l'état de facturation au " & Sh.Cells(1, 8) _
          & " pour le mois de " & Format(Sh.Cells(1, 8), "mmmm") & " " & Format(Sh.Cells(1, 8), "yyyy") & ".<br><br><br><br>" _
          & "Avec mes meilleures salutations, " & "<br>" & MaSignature
      End If
    End With
    ' Effacer les variables objet
    Set Mamessagerie = Nothing:   Set Monmessage = Nothing
  End If
End Sub

A+