Rassembler des feuilles à partir de deux fichiers

Bonsoir,

En voulant fusionner des feuilles de deux fichiers Excel différents, je rencontre des problèmes.

J'ai 2 fichiers : A et B.

Dans ces derniers, il y a des feuilles qui portent le même nom (c'est à dire que le fichier A contient la feuille X et le fichier B contient aussi une feuille appelée X), tandis que d'autres non.

Ce que je cherche à faire, c'est de fusionner, à partir des deux fichiers A et B, les feuilles ayant le même nom, dans un nouveau Workbook rassemblant les deux. Je m'explique, pour les feuilles s'appelant "X", je crée un Workbook "X" avec 2 feuilles : X-A et X-B (c'est à dire issue de A et issue de B); pour les feuilles "Y", Workbook Y avec 2 feuilles Y-A et Y-B, etc....

Et pour les feuilles n'ayant pas le même nom, je les exporte seules dans un nouveau Workbook, contenant une seule feuille.

Voilà le code qui me pose des problèmes :

Function createWorkbooks()
    Dim wbks(1 To 2) As Workbook
    Dim wbTemp As Workbook
    Dim wsA, wsB As Worksheet
    Dim strPath As String
    Dim intPath, i As Integer

    'Select workbooks
    For i = 1 To 2  'loop 2 times to select 2 files
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False   'select 1 file at a time
            intPath = .Show             'show file box
            If intPath <> 0 Then        'verify if a file has been selected
                strPath = .SelectedItems(1) 'select file path
            Else
                MsgBox "Workbook not selected. Exiting."    'if nothing is selected
                Exit Function                               'close
            End If
        End With
        Set wbks(i) = Workbooks.Open(strPath)   'open selected file
    Next i
    'Loop on first file sheets
    For Each wsA In wbks(1).Worksheets
        For Each wsB In wbks(2).Worksheets
            If wsA.Name = wsB.Name Then     'verify if some sheets have the same name
                Set wbTemp = Application.Workbooks.Add  'create wb
                With wbTemp
                    wsA.Copy after:=.Sheets(.Sheets.Count)  'copy sheets into the new file
                    .Sheets(.Sheets.Count).Name = wsA.Name & "-A"   'add the letter A to the first sheet
                    wsB.Copy after:=.Sheets(.Sheets.Count)  'copy sheets into wb
                    .Sheets(.Sheets.Count).Name = wsB.Name & "-B"   'add the letter B to the second
                    'Supprimer les feuilles vides
                    Application.DisplayAlerts = False
                    .Sheets("Sheet1").Delete
                    .Sheets("Sheet2").Delete
                    .Sheets("Sheet3").Delete
                    wbTemp.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                    wbTemp.Close savechanges:=False
                    Application.DisplayAlerts = True
                End With
            Else
                If Dir(wbks(1).Path & "\" & wsA.Name, vbDirectory) = vbNullString Then
                    wsA.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                    Application.ActiveWorkbook.Close False
                End If
                If Dir(wbks(1).Path & "\" & wsB.Name, vbDirectory) = vbNullString Then
                    wsB.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsB.Name
                    Application.ActiveWorkbook.Close False
                End If
            End If
        Next wsB
    Next wsA

End Function

Quand je l'exécute, les feuilles ne sont pas toutes exportées, et le programme se plante.

En attendant votre aide, je vous remercie d'avance !

Salut Salim,

J’ai considéré, tel que sur les exemples que je te fournis, que dans le fichier A, tu as une feuille X, une feuille Y et une feuille Z et dans le fichier B, une feuille X, une feuille Y et une feuille W.

Dans le fichier ‘’Base’’ que je te fournis, il y a une macro derrière le bouton en place qui va créer 3 nouveaux fichiers :

1) ‘’Fichier Récapitulatif X Date.du.jour_Heure_Minute_Seconde’’,

2) ‘’Fichier Récapitulatif Y Date.du.jour_Heure_Minute_Seconde’’ et

3) ‘’Fichier Récapitulatif Autres Date.du.jour_Heure_Minute_Seconde’’.

Il est bien entendu qu’une telle précision n’est nécessaire que durant la phase de test ; par la suite, par exemple si tu n’effectues ce travail qu’une fois par jour, on pourra simplifier le nom des fichiers créés.

Dans le ‘’Fichier récapitulatif X’’, tu as les feuilles X, dans le ‘’Fichier récapitulatif Y’’, tu as les feuilles Y et dans le ‘’Fichier récapitulatif Autres’’, tu as les feuilles W et Z.

A la fin de la macro, les 3 fichiers nouvellement créés sont enregistrés et le fichier ‘’Base’’ est refermé.

Pour simplifier les choses, j’ai considéré que tous les fichiers sont placés au même endroit de ton arborescence. Si ne n’est pas le cas, il faudra modifier le code en conséquence.

Sur la base de ce code, à voir si tu t’en sors pour continuer ou si tu veux me dire comment affiner tout ça.

Si je suis complètement à côté de la plaque, merci de me fournir tes fichiers !!

Cordialement.

Bonsoir Yvouille,

Merci énormément pour ta réponse .

Cependant, le problème que j'ai, c'est que les noms des feuilles (X, Y, Z...) changent souvent, c'est pourquoi j'ai voulu faire une boucle qui compare les noms, pour ne pas à avoir à changer les noms à chaque fois dans le programme, et ainsi l'automatiser.

Le problème, c'est que le programme a l'air de traiter plutôt bien les feuilles du même nom, mais dès que j'ai ajouté la partie suivante :

Else
                If Dir(wbks(1).Path & "\" & wsA.Name, vbDirectory) = vbNullString Then
                    wsA.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
                    Application.ActiveWorkbook.Close False
                End If
                If Dir(wbks(1).Path & "\" & wsB.Name, vbDirectory) = vbNullString Then
                    wsB.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsB.Name
                    Application.ActiveWorkbook.Close False

Qui est en fait destinée au reste des feuilles n'ayant pas le même nom, le programme a commencé à planter.

En fait l'objectif c'est de spliter les feuilles des deux Workbook A et B, mais en rassemblant celles ayant le même nom (X-A avec X-B etc...); et pour le reste, elles seront exportées vers de nouveaux Workbook (avec une seule feuille). C'est ça l'objectif du split auquel je songe.

Tu trouveras en fichiers joints les fichiers en question.

En attendant une nouvelle réponse de ta part, je te remercie pour ton aide.

Salut,

Afin de pouvoir t’aider, je dois d’abord pouvoir te comprendre. Peux-tu donc me confirmer ceci ?

Tu n’as jamais que deux fichiers à comparer, les fichiers A et B.

Dans ces fichiers A et B, tu as un certain nombre de feuilles X, Y, Z, etc. mais tu ne peux jamais savoir lesquelles sont présentes dans les deux fichiers ou non, il faut à chaque fois refaire la comparaison entre les feuilles des deux fichiers afin de savoir lesquelles sont cette fois, au lancement de la macro, présentes des deux côtés.

Si une, deux, trois ou plus de feuilles sont identiques dans les deux fichiers, tu désires créer 1, 2, 3 ou plus de fichiers regroupant ces feuilles identiques (par Exemple un "Fichier Récapitulatif X, un "Fichier Récapitulatif Y", un "Fichier Récapitulatif FeuilleU", etc.) et enfin un dernier fichier récapitulatif regroupant toutes les feuilles non-paires des fichiers A et B. Merci de bien préciser ce point, car si le nombre de nouveaux fichiers à créer à chaque fois n’est pas toujours identique, ça risque de changer passablement la création du code.

Dans un premier temps, le fait de placer des copies des feuilles de base des fichiers A et B dans les nouveaux fichiers est suffisant. S’il fallait traiter les données ainsi recueillies dans les nouveaux fichiers créer, ça ferait l’objet d’un complément du code actuellement en création ou de nouveaux codes.

A te relire.

Bonjour Yvouille,

Effectivement, si une, deux, trois ou plus de feuilles sont identiques dans les deux fichiers, il faut créer 1, 2, 3.... fichiers regroupant ces feuilles identiques ("Fichier Récapitulatif X, un "Fichier Récapitulatif Y", "Fichier Récapitulatif FeuilleU" etc...).

Mais pour le reste, chaque feuille doit être exporté seule vers un Fichier Récapitulatif propre à elle ("Fichier Récapitulatif W" contenant une seule feuille W, Fichier Récapitulatif Z" contenant une seule feuille Z etc...).

Apparemment il fallait rajouter ces deux boucles (Voir code) pour le cas des feuilles uniques (qui figurent sur un seul des Workbook).

La boucle que j'avais mise causait des erreurs, mais celle là résout le problème, en traitant 1 fichier à la fois au cas où les feuilles n'auraient pas de nom similaire :

'loop for unique wsA
    For Each wsA In wbks(1).Worksheets
        FoundIt = False
        For Each wsB In wbks(2).Worksheets
            If Not FoundIt Then                             'verify if some sheets have the same name
                If WorksheetFunction.Trim(wsA.Name) = WorksheetFunction.Trim(wsB.Name) Then
                    FoundIt = True
                    Exit For
                End If
            End If
        Next wsB
        If Not FoundIt Then
            wsA.Copy
            ActiveWorkbook.SaveAs Filename:=wbks(1).Path & "\" & wsA.Name
            ActiveWorkbook.Close False
        End If
    Next wsA

'loop for unique wsb
    For Each wsB In wbks(2).Worksheets
        FoundIt = False
        For Each wsA In wbks(1).Worksheets
            If Not FoundIt Then                                 'verify if some sheets have the same name
                If WorksheetFunction.Trim(wsB.Name) = WorksheetFunction.Trim(wsA.Name) Then
                    FoundIt = True
                    Exit For
                End If
            End If
        Next wsA
        If Not FoundIt Then
            wsB.Copy
            ActiveWorkbook.SaveAs Filename:=wbks(2).Path & "\" & wsB.Name
            ActiveWorkbook.Close False
        End If
    Next wsB

wbks(1).Close False
wbks(2).Close False
Application.ScreenUpdating = True

End Function

Merci encore pour ton aide !

À bientôt !