Assembler des feuilles dans un nouveau fichier

Bonjour tout le monde,

L'objectif de mon programme est de rassembler toutes les feuilles Excel qui contiennent des données en "A4" dans un nouveau fichier Excel. Le nouveau fichier sera placé dans un nouveau dossier, créé par le programme.

Mon programme me permet bien de créer le dossier, mais pas le nouveau fichier Excel avec les feuilles.

Je n'arrive pas à savoir si c'est un problème de création de fichier ou bien de Copier/Coller.

Quelles modifications dois-je apporter ?

Merci d'avance.

Sub Assembler_les_feuilles()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xNWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & Split(xWb.Name, ".")(0) & " " & DateString

If Val(Application.Version) < 12 Then
    FileExtStr = ".xls": FileFormatNum = -4143
Else
    FileExtStr = ".xlsx": FileFormatNum = 51
End If

MkDir FolderName

On Error GoTo NErro
    If xWs.Range("A4") <> "" Then
        xWb.Worksheets(Array(xWs.Name)).Copy
    End If
    Set xNWb = ActiveWorkbook
    xFile = FolderName & "\" & xWs.Name & FileExtStr
    xNWb.BuiltinDocumentProperties("Title").Value = Worksheets(2).Name
    xNWb.SaveAs xFile, FileFormat:=FileFormatNum
    xNWb.Close False, xFile

NErro:

xWb.Activate
MsgBox "Voici l'emplacement du fichier " & FolderName

Application.ScreenUpdating = True

End Sub

Bonjour CarteSime,

Tes feuilles qui contiennent (ou pas) des données en A4 sont-elles dans un seul fichier au départ ?

Ta macro ne boucle pas sur l’ensemble (ou une partie) des feuilles du fichier, est-ce volontaire ?

Sauf erreur, il me semble qu’il manque une instruction « Exit Sub » juste avant « NErro: ».

Mes remarques ne résolvent pas ton problème de sauvegarde de fichier, mais j’essaie de comprendre… À quel endroit est-ce que ça bloque ?

Peux-tu mettre en commentaire la ligne « On Error GoTo NErro » pour voir où il y a une erreur ?

Bonjour Valky68,

J'ai réalisé l'ensemble des modifications que vous m'avez proposé, mais j'ai toujours le même problème.

Pour répondre à vos questions, toutes mes feuilles sont dans le même fichier au départ. La macro doit boucler l'ensemble de ces feuilles.

Merci pour votre aide

Bonjour CarteSime, Valky68

Un nom de dossier ne peut contenir les séparateurs de date /, il est mieux de ne pas mettre d'espace, ni le séparateur des heures.

J'ai ajouté la ligne :

Debug.Print FolderName

pour voir où était le problème.

Utiliser l'instruction Replace pour disposer d'un nom de dossier conforme à ce que le système accepte

Bonjour Scraper,
Je ne crois pas qu’il y ait de dates avec des séparateurs "/" dans le chemin d’accès au fichier à sauvegarder. L’instruction DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")permet justement d’éviter ça.