XL 2019 Copier ajouter exporter

[xamenod]

Bonjour,
j'ai réalisé une macro dont voici un extrait .
le but est de copier l'onglet BASE à la fin du classeur, de le renommer avec les valeurs de cellules sur la Feuille SUPPORT.
Puis de créer un dossier avec le nom de la feuille nouvellement créée.
ensuite de l'exporter en PDF dans le dossier nouvellement créé.

Ce qui dysfonctionne: la macro créée un nouveau classeur, ce qui n'est pas souhaitable, et bloque à la création du dossier.
voici le code et un fichier joint.

Merci pour votre aide

Henry

Sub export()
Dim NomFeuilleBase As String
NomFeuilleBase = Sheet("SUPPORT").Range("A1").Value & "_" & Sheet("SUPPORT").Range("B3").Value

Dim NomDossier As String
NomDossier = NomFeuilleBase

Dim CheminDossier As String
CheminDossier = ThisWorkbook.Path & "\"

'copier coller la nouvelle feuille à la fin du classeur et la renommer

Sheets("BASE").Copy
Sheets.Add after:=ActiveWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = NomFeuilleBase


'créer dossier avec nom de la nouvelle feuille
If Len(Dir(NomDossier, vbDirectory)) = 0 Then
MkDir CheminDossier & NomFeuiileBase
End If


' Enregistrer la Feuille en PDF dans le dossier créé

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomPdf, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub

 

[_Thierry]

Bonjour @xamenod , Le Forum

Ta macro est un peu en vrac !

J'ai repris un peu le code, je te conseille d'essayer comme ceci :

Option Explicit

Sub Export_PDF()
Dim WS As Worksheet
Dim NomFeuilleBase As String
Dim NomDossier As String
Dim CheminDossier As String
Dim NomPdf As String

Set WS = ThisWorkbook.Worksheets("Support")


NomFeuilleBase = WS.Range("A1").Value & "_" & WS.Range("B3").Value
NomDossier = NomFeuilleBase
CheminDossier = ThisWorkbook.Path & "\"

'copier coller la nouvelle feuille à la fin du classeur et la renommer
Sheets("BASE").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = NomFeuilleBase


'créer dossier avec nom de la nouvelle feuille
If Len(Dir(CheminDossier & NomFeuilleBase, vbDirectory)) = 0 Then
MkDir CheminDossier & NomFeuilleBase
End If


NomPdf = "Export-PDF-" & Format(Now, "YYYY-MM-DD-hh-mm-ss") & ".pdf"

'Enregistrer la Feuille en PDF dans le dossier créé
ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=CheminDossier & NomFeuilleBase & "\" & NomPdf, _
                OpenAfterPublish:=True
End Sub

NB le classeur reste en l'état avec une feuille ajoutée "ETAT_Neuf" qui bloquera une seconde exécution car il y aura duplication du nom de Feuille, à toi de savoir ce que tu veux en faire ?


Bonne continuation
@+Thierry

 

[_Thierry]

Re @xamenod , le Forum

Et tant que j'avais ton classeur et le code sous les yeux, avant de tout fermer, j'en ai profité pour améliorer et anticiper la destruction de la feuille temporaire...

Option Explicit

Sub Export_PDF_V2()
Dim WB As Workbook
Dim WSSupport As Worksheet, WSBase As Worksheet, WSTemp As Worksheet
Dim NomFeuilleBase As String
Dim NomDossier As String
Dim CheminDossier As String
Dim NomPdf As String

Set WB = ThisWorkbook
Set WSSupport = WB.Worksheets("Support")
Set WSBase = WB.Worksheets("BASE")


NomFeuilleBase = WSSupport.Range("A1").Value & "_" & WSSupport.Range("B3").Value
NomDossier = NomFeuilleBase
CheminDossier = WB.Path & "\"

'copier coller la nouvelle feuille à la fin du classeur et la renommer
WSBase.Copy After:=WB.Worksheets(WB.Worksheets.Count)
Set WSTemp = WB.Worksheets(WB.Worksheets.Count)
WSTemp.Name = NomFeuilleBase


'créer dossier avec nom de la nouvelle feuille
If Len(Dir(CheminDossier & NomFeuilleBase, vbDirectory)) = 0 Then
MkDir CheminDossier & NomFeuilleBase
End If


NomPdf = "Export-PDF-" & Format(Now, "YYYY-MM-DD-hh-mm-ss") & ".pdf"

' Enregistrer la Feuille en PDF dans le dossier créé
WSTemp.ExportAsFixedFormat _
       Type:=xlTypePDF, _
       Filename:=CheminDossier & NomFeuilleBase & "\" & NomPdf, _
       OpenAfterPublish:=True

' Suppression de la feuille temporaire qui a servi à faire le PDF
Application.DisplayAlerts = False
WSTemp.Delete
Application.DisplayAlerts = True

End Sub

Bien à toi, à vous
@+Thierry

 

[xamenod]

Merci beaucoup Thierry, je vais tester ce code cet après-midi.

 

[xamenod]

Merci Thierry, la macro est un peu en vrac, oui, je n'ose même pas montrer le reste du code, celle-ci en est seulement une partie, je fais avec les moyens du bord

Ta macro fonctionne super bien.
Merci beaucoup
Bon après-midi.

 

[_Thierry]

Re

je rencontre un problème, entre autre, la feuille excel est bien exportée en PDF dans le bon dossier, mais ne reste pas en dernière position dans le classeur.

Normal si tu utilses la version qui l'élimine !

Mets ceci en commentaires (ou supprimes tout) :

' Suppression de la feuille temporaire qui a servi à faire le PDF
Application.DisplayAlerts = False
WSTemp.Delete
Application.DisplayAlerts = True

Mais par contre il faut que tu trouves un nom unique par onglet créé, tu dois ajouter ceci au bon endroit du code existant :

'copier coller la nouvelle feuille à la fin du classeur et la renommer
WSBase.Copy After:=WB.Worksheets(WB.Worksheets.Count)
Set WSTemp = WB.Worksheets(WB.Worksheets.Count)
WSTemp.Name = NomFeuilleBase & "_" & Format(Now, "YYMMDD-HHMMSS")

Pour le reste, je te laisse avancer un peu car je ne sais pas du tout ce que tout ce blah blah de macro est sensé faire et on s'écarte quand même de la demande de ce Fil de discussion : "Copier ajouter exporter"

Bon courage
@+Thierry

 

[xamenod]

Merci beaucoup, je vais essayer.
Bonne soirée