imprimer zone identique sur plusieurs onglets

Private Sub Envoi_Janvier_Click()
Call Impr
Unload Me
End Sub

Sub Impr()
Dim Sh As Worksheet
Dim Nms As Name
Application.ScreenUpdating = False
For Each Nms In Names
    If InStr(1, Nms.Name, "Print_Area") > 0 Then
        Nms.Delete
    End If
Next Nms
For Each Sh In Sheets
    If Sh.Name <> "Accueil Service continu" And Sh.Name <> "DATA" Then
        Sh.Select
        Exit For
    End If
Next Sh
For Each Sh In Sheets
    If Sh.Name <> "Accueil Service continu" And Sh.Name <> "DATA" Then
        Sh.PageSetup.PrintArea = "$A$1:$M$46"
        Sh.Select False
    End If
Next Sh
ActiveWorkbook.Windows(1).SelectedSheets.PrintPreview 'a remplacer par PrintOut
Sheets("Accueil Service continu").Select
'Unload Me
End Sub

Private Sub CommandButton1_Click()
  Dim Sh As Worksheet
  For Each Sh In Sheets
    If Sh.Name <> "accueil service continu" And Sh.Name <> "DATA" Then
      Sh.PageSetup.PrintArea = "$A$58:$M$103"
      MsgBox Sh.Name 'pour contrôle donc à supprimer
      'Sh.PrintOut pour ne pas imprimer inutilement sinon déplacer ' après Out
    End If
  Next
  Unload Me
End Sub

Sub mWKB2PDF()
Dim sh As Worksheet, Chemin$
Chemin = ActiveWorkbook.Path & "\"
For Each sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Accueil Service continu" And Sh.Name <> "DATA" Then
        sh.PageSetup.PrintArea = "$A$1:$M$46"
        sh.Select False
        Else
        sh.Visible = False
    End If
Next sh
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, strPath & "NOMFichierPDF.pdf"
End Sub