Generation automatique de fichier avec macro

Bonjour,

il y a quelques temps j'ai mis en place une macro qui me faisait une génération automatique de fichier selon un tableau dans mon fichier excel et qui imprimait tout seul comme un grand, avec votre aide.

Aujourd'hui je souhaite enregistrer chaque "woorksheet" générée en un fichier plutôt que de l'imprimer, j'ai donc modifier le code et en lieu et place d'utiliser la commande "printout", j'utilise la commande "saveas".

Cela fonctionne bien, mais dans mon fichier généré il m'enregistre la macro avec, or je voudrais simplement enregistrer comme un fichier simple, j'ai essayer de choisir plusieurs combinaisons de fileformat, mais j'ai une erreur à chaque coup, je ne sais pas comment faire autrement, si vous avez une idée je suis preneur, je vous met mon code ci dessous :

Option Explicit

Sub publipostage()
Dim newWst As Worksheet, curCell As Range
Dim Fichier As String
Set curCell = ThisWorkbook.Sheets("Feuil1").Range("A6")

'créer une nouvelle feuille
ThisWorkbook.Worksheets("Feuil4").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set newWst = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'supprimer le bouton de la feuille
'newWst.Shapes("Rectangle 1").Delete

'boucle sur les entrées de la Feuil1
While curCell.Value <> vbNullString
    With newWst
        'copier les valeurs
        .Range("I8").Value = curCell.Value
        .Range("F9").Value = curCell.Offset(0, 2).Value
        .Range("R9").Value = curCell.Offset(0, 3).Value
        .Range("R8").Value = curCell.Offset(0, 5).Value
        .Range("I6").Value = curCell.Offset(0, 9).Value
        .Range("P13").Value = curCell.Offset(0, 12).Value
        .Range("R6").Value = curCell.Offset(0, 10).Value
        .Range("R7").Value = curCell.Offset(0, 11).Value
        'impripmer la feuille (printout) ou la sauvegarder (saveas)
        On Error Resume Next
        '.PrintOut
        Fichier = ActiveWorkbook.Path & "\TEST" & curCell.Offset(0, 13).Value & ".xlsm"
        'Fichier = "C:\TEST" & curCell.Offset(0, 13).Value & ".xlsm"
        .SaveAs Filename:=Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        '.SaveAs Filename:=Fichier, FileFormat:=51
        On Error GoTo 0
    End With
    Set curCell = curCell.Offset(1, 0)
Wend

'supprime la nouvelle feuille
Application.DisplayAlerts = False
newWst.Delete
Application.DisplayAlerts = True

End Sub

Merci d'avance

David

Bonjour,

et en mettant l'extension ".xlsx" au lieu de ".xlsm" ?

j'avais déjà essayé me semble t'il, mais plus sur à 100%...

Avec xls c'est sur que ca ne fonctionne pas et je crois qu'avec cette extension, il me demande à chaque génération de fichier et au moment de l'enregistrement, une confirmation avec une fenêtre popup, donc c'est pas vraiment automatisé....

Essayer ceci

    Application.DisplayAlerts = False
    Fichier = ActiveWorkbook.Path & "\TEST" & curCell.Offset(0, 13).Value
    .SaveAs Filename:=Fichier, FileFormat:=xlOpenXMLWorkbook

Bonsoir,

Impeccable ca fonctionne merci