Regrouper deux codes sur une macro

Bonsoir à tous !!

actuellement j'ai deux boutons avec un code different.

Comment reunir ces deux codes pour que ma macro enregistreconsigneracc execute les deux.

C'est tout bete je sais, mais je me casse le cerveau ..

Je commence à etre accroc a excel

Sub enregistreconsigne()
Dim Chemin As String, Fichier As String

  Fichier = Sheets("fiche consigne").Range("E6") & " " & Sheets("fiche consigne").Range("E8") & " " & Sheets("fiche consigne").Range("E9")
  If Len(Trim(Fichier)) = 0 Then
    MsgBox "Pas de nom de fichier"
    Exit Sub
  End If

  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "g:\perso\gestion\Installations\"
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With

  Sheets("fiche consigne").Copy
  With ActiveWorkbook
    .SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close
  End With

  Sheets("fiche consigne").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End Sub
Sub enregistreraccordement()
Dim Chemin As String, Fichier As String

  Fichier = Sheets("fiche raccordement").Range("E6") & " " & Sheets("fiche raccordement").Range("E8")
  If Len(Trim(Fichier)) = 0 Then
    MsgBox "Pas de nom de fichier"
    Exit Sub
  End If

  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "g:\perso\gestion\Installations\"
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With

  Sheets("fiche raccordement").Copy
  With ActiveWorkbook
    .SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close
  End With

  Sheets("fiche raccordement").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End Sub

Bonjour

Fournis un fichier pour tester

Sub Enregistre2Feuilles()
Dim Chemin As String, Fichier As String
Dim LesFeuilles, I As Integer

  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "g:\perso\gestion\Installations\"
    If .Show = -1 Then        ' Clic sur Ok
      Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
      Exit Sub
    End If
  End With

  LesFeuilles = Array("fiche consigne", "fiche raccordement")
  For I = 0 To UBound(LesFeuilles)
    With Sheets(LesFeuilles(I))
      Fichier = .Range("E6") & " " & .Range("E8")
      If I = 0 Then Fichier = Fichier & " " & .Range("E9")    ' Pour la fiche consigne on rajoute E9
      If Len(Trim(Fichier)) = 0 Then
        MsgBox "Pas de nom de fichier pour la page """ & LesFeuilles(I) & """"
        Exit Sub
      End If

      .Copy
      With ActiveWorkbook
        .SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        .Close
      End With

      .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                               IgnorePrintAreas:=False, From:=1, to:=1, OpenAfterPublish:=False
    End With
  Next I
End Sub

Ca fonctionne parfaitement avec ce code merciiiiii

Rechercher des sujets similaires à "regrouper deux codes macro"