Sauvegarde fichier en Excel et non plus en pdf

Bonjour,

J'ai actuellement un macro qui me permet de sauvegarder le fichier excel au format pdf dans un chemin spécifique selon la société.

J'aurai besoin de transformer la macro pour qu'elle fasse la même chose mais qu'elle sauvegarde au format excel afin d'avoir la main sur le fichier plus tard.

Pourriez-vous m'aider ?

Je ne comprends pas bien comment modifier le bout de code suivant :

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _

, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, OpenAfterPublish:=False

Code complet + je joins le fichier en copie.

Sub Sauvegarde()

Dim MyName As Range

Dim LName As String

Dim MySociete As Range

Set MyName = Range("C3")

Set MySociete = Range("J2")

LName = Left(MyName, 1)

If MySociete.Value = "RENAULT TRUCKS SAS" Then

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _

, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, OpenAfterPublish:=False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

MsgBox "Déplacer le document dans le dossier du salarié"

Call Shell("explorer.exe " & Path, vbNormalFocus)

End If

If MySociete.Value = "Renault Trucks Defense" Then

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".pdf" _

, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, OpenAfterPublish:=False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

MsgBox "Déplacer le document dans le dossier du salarié"

Call Shell("explorer.exe " & Path, vbNormalFocus)

End If

End Sub

Merci d'avance pour votre aide.

Cédric

11avenants-mm-tm.xlsx (36.62 Ko)

Bonjour pitochico,

voici le code adapté:

Sub SauvegardeXL()

    Dim MyName As String, LName As String, MySociete As String, MonFichier As String
    Dim wb As Workbook

    MyName = Range("C3")
    MySociete = Range("J2")
    LName = Left(MyName, 1)

    If MySociete = "RENAULT TRUCKS SAS" Then

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"

        MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"

        ActiveSheet.Copy        
        Set wb = ActiveWorkbook

        With wb
            .SaveAs Path & MonFichier
            .Close False
        End With

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        MsgBox "Déplacer le document dans le dossier du salarié"

        Call Shell("explorer.exe " & Path, vbNormalFocus)

    End If

    If MySociete = "Renault Trucks Defense" Then

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"

        MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & ActiveSheet.Range("C3").Value & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"

        ActiveSheet.Copy
        Set wb = ActiveWorkbook                
        With wb
            .SaveAs Path & MonFichier
            .Close False
        End With

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        MsgBox "Déplacer le document dans le dossier du salarié"

        Call Shell("explorer.exe " & Path, vbNormalFocus)

    End If

End Sub

Cordialement

Merci Sequoyah,

Cela correspond en partie à mon besoin, cependant la macro ne sauvegarde que l'onglet "décomposition", hors j'aurai besoin de sauvegarder l'ensemble du fichier Excel pour pouvoir le réutiliser plus tard au besoin.

A savoir les onglets :

décomposition

avenant TP thérapeut

Possible de m'aider sur ce point ?

Merci d'avance.

Cédric

Bonjour Cédric:

voici le nouveau code:

Sub SauvegardeXL2()

    Dim MyName As String, LName As String, MySociete As String, MonFichier As String
    Dim wb As Workbook

    MyName = Range("C3")
    MySociete = Range("J2")
    LName = Left(MyName, 1)

    If MySociete = "RENAULT TRUCKS SAS" Then

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RT SAS\" & LName & "\"

        MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & MyName & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"

        Sheets(Array("Décomposition", "Avenant TP thérapeut")).Copy

        Set wb = ActiveWorkbook

        With wb
            .SaveAs Path & MonFichier
            .Close False
        End With

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        MsgBox "Déplacer le document dans le dossier du salarié"

        Call Shell("explorer.exe " & Path, vbNormalFocus)

    End If

    If MySociete = "Renault Trucks Defense" Then

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Path = "\\vcn.ds.volvo.net\rtc-lyon\proj01\011096\PERSONNEL FILES\RTD\" & LName & "\"

        MonFichier = "Organisation du temps de travail TP thérapeutique" & " - " & MyName & " " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C2").Value & ".xlsx"

        Sheets(Array("Décomposition", "Avenant TP thérapeut")).Copy

        Set wb = ActiveWorkbook

        With wb
            .SaveAs Path & MonFichier
            .Close False
        End With

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        MsgBox "Déplacer le document dans le dossier du salarié"

        Call Shell("explorer.exe " & Path, vbNormalFocus)

    End If

End Sub

Super encore fois, correspond parfaitement à mon besoin maintenant

un grand merci de toute l'équipe RH pour ton aide

Rechercher des sujets similaires à "sauvegarde fichier pdf"