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,