Copier des onglets dans un nouveau fichier

tamatave33 · 22 Novembre 2018

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".
Cette macro me permet aussi de masquer des colonnes et de mettre en couleur des cellules de l'onglet "Sortie", en fonction de la valeur saisie dans la cellule M4 de l'onglet "Sortie" (cela se fait avec les macros Sortie_xxx).
Sur mon PC, tout fonctionne correctement, mais sur un MAC cela ne marche pas.
Lorsque la fenêtre pour le choix du dossier où sera enregistré le nouveau classeur, s'ouvre, j'ai le message suivant : "Microsoft Visual Basic - Variable objet ou variable de bloc With non définie".
Voici le code pour copier les onglets :

Code:

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 :

Code:

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

[FONT=Verdana, Arial, Tahoma, Calibri, Geneva, sans-serif]Je n'arrive pas à trouver cette erreur.
Merci pour votre aide.
[/FONT]

Copier des onglets dans un nouveau fichier

tamatave33

XLDnaute Occasionnel

Discussions similaires