Code VBA pour copier une image et la coller sur plusieurs onglets

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'le logo doit avoir la propriété "Déplacer et dimensionner avec les cellules"
Dim F As Worksheet, a$, s As Shape
Set F = Feuil1 'feuille modèle
a = "$A$1" 'adresse de la cellule contenant le logo
For Each s In Sh.Shapes
  If s.TopLeftCell.Address = a Then Exit Sub
Next
F.Unprotect "mdp" 'mot de passe, facultatif
Sh.Unprotect "mdp" 'mot de passe, facultatif
Sh.Range(a).RowHeight = F.Range(a).RowHeight 'hauteur ligne
Sh.Range(a).ColumnWidth = F.Range(a).ColumnWidth 'largeur colonne
F.Range(a).Copy Sh.Range(a)
Sh.Protect "mdp" 'mot de passe, facultatif
F.Protect "mdp" 'mot de passe, facultatif
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'le logo doit avoir la propriété "Déplacer et dimensionner avec les cellules"
Dim F As Worksheet, a$, s As Shape
Set F = Feuil1 'CodeName de la feuille "rapport"
a = "$D$5" 'adresse de la cellule contenant le logo
If Sh.Name = F.Name Then Exit Sub
For Each s In Sh.Shapes
  If s.TopLeftCell.Address = a Then Exit Sub
Next
Sh.Range(a).RowHeight = F.Range(a).RowHeight 'hauteur ligne
Sh.Range(a).ColumnWidth = F.Range(a).ColumnWidth 'largeur colonne
F.Range(a).Copy Sh.Range(a)
End Sub