XL 2016 Sauvegarder des onglets en XLSX et non en PDF

[fenec]

Bonjour le forum,

J’ai trouvé sur la toile un code pour sauvegarder des onglets qui fonctionne très bien mais on me demande la même chose mais pas en les exportant en PDF mais en les sauvegardant seulement dans un fichier défini en xlsx. Vous joints le code trouvé sur le net.

Sub Archiver_Equipages_Pdf()
Dim nom$, Chemin$, temp, T
Dim x, I As Integer
    Application.ScreenUpdating = False    
    I = 7
    For x = 8 To Sheets.Count
        I = I + 1
        Sheets(I).Activate        
        temp = Split(ThisWorkbook.Name, ".xlsm")(0)
        nom = ActiveSheet.Name & " " & temp
        Chemin = ThisWorkbook.Path & "\Sauvegarde Equipages PDF\"        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & nom & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        From:=1, To:=1, OpenAfterPublish:=False      
        T = Timer + 0.5: Do Until Timer > T: DoEvents: Loop
    Next x        
        Sheets("Equipages").Activate        
        MsgBox "Vos onglets ont bien été sauvegarder", vbInformation, "INFORMATION"
    Application.ScreenUpdating = True
End Sub

Je viens donc vers vous pour faire la même chose mais en xlsx

Cordialement,

Philippe.

 

[juvaxe]

Bonsoir

As-tu essayé de mettre xlTypeXLSX là où tu as xlTypePDF dans ta routine de sauvegarde ?

 

[juvaxe]

Ma réponse est partie un peu vite ...

Je voulais ajouter que pour trouver une équivalence VBA , il est toujours possible de démarrer l'enregistrement d'un macro, faire manuellement ce qu'on veut faire automatiquement pour arrêter l'enregistrement de la macro et voir ce que Excel a créé en terme de procédure VBA

Cdt

 

[kiki29]

Salut, à adapter à ton contexte

Option Explicit

Sub Sauver_XLSX()
Dim sNomFeuille As String
Dim Wkb As Workbook
Dim sDossier As String
Dim i As Long
Dim sExt As String, Dep As Currency
Dim sDossierSauvegardeXLSX As String
Dim iNb As Long
    sDossierSauvegardeXLSX = "XLSX"
    Application.StatusBar = ""
    Dep = Timer
    sDossier = ThisWorkbook.Path & "\" & sDossierSauvegardeXLSX
    sExt = ".xlsx"
    Application.ScreenUpdating = False
    iNb = Worksheets.Count
    For i = 8 To iNb
        sNomFeuille = Sheets(i).Name
        Set Wkb = Workbooks.Add
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets(i).UsedRange.Copy Wkb.Worksheets(1).Range("A1")
        With Wkb
            .Worksheets(1).UsedRange.EntireColumn.AutoFit
            .Worksheets(1).Range("A1").Select
            .SaveAs Filename:=sDossier & "\" & sNomFeuille & sExt, _
                    FileFormat:=xlOpenXMLWorkbook
            .Close
        End With
        Application.CutCopyMode = False
        Application.DisplayAlerts = True
        Set Wkb = Nothing
        DoEvents
    Next i
    Application.ScreenUpdating = True
    Application.StatusBar = "Sauvegarde terminée : " & Format(Timer - Dep, "0.00 s")
End Sub