Aide code VBA copier des onglets dans un nouveau fichier

Bonjour le forum,

J'ai un classeur Excel composé de plusieurs onglets : "Partenaires postulants", "sorties 2018", "partenaires", "Sortie", ...

En parcourant divers sujets dans le forum, j'ai trouvé un code qui me permet de faire la copie des onglets "Partenaires postulants", "sorties 2018" et "partenaires" dans un nouveau classeur. Le nom du nouveau fichier est le nom saisi dans la cellule M6 de l'onglet "Sortie".

Sur mon PC, cela fonctionne correctement, mais sur d'autres ordi, MAC notamment cela ne marche pas.

La macro va sur l'instruction On Error GoTo Erreur1, la copie des onglets ne se fait pas, un classeur s'ouvre qui ne porte pas le nom saisi dans la cellule M6 de l'onglet "Sortie", avec des onglets vierges, comme si c'était un nouveau classeur.

Voici le code pour copier les onglets :

Sub Extraire_Sortie()
    Dim a, e, Rep As Integer, Repertoire As String, Nomsortie As String
    If Range("M4") = 0 Or Range("M4") = "" Then
        Rep = MsgBox("Le n° de la sortie dans la cellule M4 n'a pas été saisi.")
    Else
    If Range("M6") = 0 Or Range("M6") = "" Then
        Rep = MsgBox("Le nom du fichier pour la sauvegarde du fichier Excel joint au compte-rendu de la sortie n'a pas été saisi dans la cellule M6.")
    Else
    If Range("M4") = 905 Then Call Sortie_905
    If Range("M4") = 906 Then Call Sortie_906
    If Range("M4") = 907 Then Call Sortie_907
    If Range("M4") = 908 Then Call Sortie_908
    If Range("M4") = 909 Then Call Sortie_909
    If Range("M4") = 910 Then Call Sortie_910
    If Range("M4") = 911 Then Call Sortie_911
....
....
    MsgBox ("Indiquer le repertoire où sera enregistré le fichier.")
    Repertoire = ChoixDossier
    Application.DisplayAlerts = False

    Nomsortie = Sheets("Sortie").Range("M6")
    Rep = vbYes
    If Dir(Repertoire & "\" & Nomsortie & ".xlsx") <> "" Then
        Rep = MsgBox("Ce fichier existe déjà, veux-tu le remplacer ?", vbYesNo)
    End If

    If Rep = vbYes Then
        On Error GoTo Erreur1

        a = Array("Partenaires des Postulants", "Sorties 2018", "Partenaires")
            With Workbooks.Add(xlWBATWorksheet)
                For Each e In a
                    ThisWorkbook.Sheets(e).Copy After:=.Sheets(.Sheets.Count)
                Next
                .Sheets(1).Delete
                .Sheets(1).Select
                .SaveAs Repertoire & "\" & Nomsortie
                .Close
            End With
    End If
    End If
    End If

    Application.ScreenUpdating = True

Exit Sub

Erreur1:
    MsgBox ("Un fichier portant le même nom est déjà ouvert. Le nom du nouveau fichier sera par défaut Feuil(n) et ne sera pas enregistré.")

End Sub

Et le code pour le choix du dossier :

Function ChoixDossier()

    Dim Sh, Dos

    If Val(Application.Version) >= 10 Then

        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path & "\"
            ChoixDossier = IIf(.Show = -1, .SelectedItems(1), "")
        End With

    Else

        Set Sh = CreateObject("Shell.Application")
        Set Dos = Sh.BrowseForFolder(&H0&, "Répertoire.", &H4000)
        ChoixDossier = Dos.ParentFolder.ParseName(Dos.Title).Path & "\"

    End If

End Function

Merci d'avance pour votre aide.

Bonjour,

je sais que la syntaxe n'est pas la même sur mac que pc, surtout en ce qui concerne le répertoire (path)

d’après ce que j'ai lu sur le site de Ron, la syntaxe varie selon les versions d'Excel sur mac.

voir les connaissance de Ron à ce sujet sur son site,

https://www.rondebruin.nl/mac/section3.htm

Rechercher des sujets similaires à "aide code vba copier onglets nouveau fichier"