XL 2016 deplacer copier onglets vers nouveaux classeurs VBA

Philou0607 · 21 Février 2023

Bonjour,
J'ai un fichier excel récurrent (mensuel) qui contient environ 25 onglets. Chaque onglet contient des données confidentielles à un service que j'adresse mensuellement. J'avais récupéré un bout de code qui me sauvegarde le fichier cible avec NouveauNom.xlsx".
Comment améliorer ce code pour qu'un nouveau classeur soit créé pour chaque onglet du fichier source et qu'il soit sauvegardé en pdf avec comme nom de classeur le nom de l'onglet source correpondant.
Je ne sais pas si je suis très clair, enfin je l'espère.
Ci-dessous, le code que j'ai récupéré en fouinant sur le net.
Merci pour votre aide.

Sub copieonglet()

Dim Sh As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("DT CENTRE", "DT 5-6", "DT 7-8", "DT 9-10")).Copy
with activeworkbook

For Each Sh In .Worksheets

sh.usedrange.value = sh.usedrange.value
Next Sh
.saveas "NouveauNom.xlsx", 51
.close true
end with
Application.DisplayAlerts = True
Application.ScreenUpdating = true

End Sub

sylvanu · 21 Février 2023

Bonjour Philou,
Cette PJ enregistre chaque feuille dans le dossier courant en pdf. Avec :

VB:

Sub EnregPDF()
    For Each F In Worksheets
        Nom = F.Name & ".pdf"
        Application.StatusBar = "Enregistrement : " & Nom
        Sheets(F.Name).ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nom, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next F
    Application.StatusBar = ""
End Sub

Philou0607 · 21 Février 2023

@sylvanu
Merci pour ta réponse.
Donc si je comprends bien et c'est pas gagné, en exécutant le code ci-dessus cela me génére un fichier pdf ? où est il généré stp ? je ne le retrouve pas.
merci et désolé pour mon ignorance.

sylvanu · 21 Février 2023

sylvanu à dit:
dans le dossier courant

Ils se trouvent dans le même dossier que le dossier courant dans lequel est votre fichier XL.

Philou0607 · 21 Février 2023

Ok je viens de comprendre. Un peu long à la détente. Sans abuser, si je souhaite que ces fichiers pdf aillent ailleurs que dans le dossier courant du fichier xlsm, comment dois-je m'y prendre ? indiquer dans le code le chemin du dossier de destination ?
merci d'avance

sylvanu · 21 Février 2023

Il suffit de l'indiquer dans le nom :

VB:

Sub EnregPDF()
    For Each F In Worksheets
        Chemin = "C:\Users\PC_PAPA\Desktop\ESSAI\"  ' Chemin à définir. Doit se terminer par "\"
        Nom = Chemin & F.Name & ".pdf"
        Application.StatusBar = "Enregistrement : " & Nom
        Sheets(F.Name).ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nom, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next F
    Application.StatusBar = ""
End Sub

Philou0607 · 21 Février 2023

Super. ça parait si simple quand tu le dis comme ça. Merci bcp.

Philou0607 · 21 Février 2023

une dernière question. Si je souhaite que les onglets transférés restent au format inital, c'est à dire en xlsm et qu'ils conservent également le même nom que l'onglet source, que dois je modifier dans le code stp ?
Merci

sylvanu · 21 Février 2023

En fait, ça n'a plus rien à voir. La gestion en pdf et en xls est complétement différente.
Un ex en PJ avec :

VB:

Sub EnregXLS()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False   ' Masque le message " Ce fichier existe déjà ..."
    For Each F In Worksheets
        If F.Name <> "Entete" Then
            Chemin = "C:\Users\PC_PAPA\Desktop\ESSAI\"  ' Chemin à définir. Doit se terminer par "\"
            Nom = Chemin & F.Name & ".xlsx"
            'Copie de la feuille courante dans un nouveau classeur et enregistrement
            Sheets(F.Name).Select
            ActiveSheet.Copy
            ActiveWorkbook.SaveAs Filename:=Nom
            ActiveWorkbook.Close
        End If
    Next F
    Sheets("Entete").Select
    Application.StatusBar = ""
    Application.DisplayAlerts = True
End Sub

Toutes les feuilles sont traitées sauf la feuille Entete.

Philou0607 · 22 Février 2023

Merci encore Sylvanu pour cette mine d'informations

Philou0607 · 8 Mars 2023

Bonjour,

Dans l'exemple donné, je souhaite que les feuilles "NePasCopier1" et "NePasCopier2" du fichier joint, au même titre que la feuille Entete, ne soient pas copiées dans le nouveau classeur. Je comprends que je dois l'écrire dans le code avant le then et en nommant les feuilles non copiées... mais je ne sais pas comment l'écrire en vba. Merci pour vos retours

Sub EnregXLS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Masque le message " Ce fichier existe déjà ..."
For Each F In Worksheets
If F.Name <> "Entete" Then
Chemin = "C:\Users\PC_PAPA\Desktop\ESSAI\" ' Chemin à définir. Doit se terminer par "\"
Nom = Chemin & F.Name & ".xlsx"
'Copie de la feuille courante dans un nouveau classeur et enregistrement
Sheets(F.Name).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close
End If
Next F
Sheets("Entete").Select
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub

sylvanu · 8 Mars 2023

Bonjour Philou,
Il suffit de faire un ET.
NomFeuille différent de xxx ET différent de yyy ET différent de zzz :

VB:

If F.Name <> "Entete" And F.Name <> "NePasCopier1" And F.Name <> "NePasCopier2" Then

Philou0607 · 8 Mars 2023

Merci bcp. J'ai l'air un peu bête.

sylvanu · 8 Mars 2023

Qui que nous soyons, nous apprenons un peu chaque jour.
Ceux qui pensent tout savoir, ne savent rien.

Philou0607 · 8 Mars 2023

Le test est super concluant. Une dernière chose stp : si je souhaite que les feuilles copiées dans le nouveau classeurs excel soient protégées en écriture, que dois je ajouter dans le code actuel. Et j'espère que cela sera ma dernière question... j'abuse un peu. Merci

XL 2016 deplacer copier onglets vers nouveaux classeurs VBA

Philou0607

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Philou0607

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Philou0607

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Philou0607

XLDnaute Nouveau

Philou0607

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Philou0607

XLDnaute Nouveau

Philou0607

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Philou0607

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Philou0607

XLDnaute Nouveau

Discussions similaires