Importer et fusionner plusieurs feuilles Excel

Bonjour à toutes et tous,

Voilà, je vous explique mon petit soucis.. j'ai trouvé ces lignes de codes qui fonctionnent parfaitement mais je voudrais savoir si je peux sélectionner une seule feuille dans chaque classeur choisi et les fusionner en une seule feuille ? et je ne vois pas comment faire...

Ces lignes sont très bien car je peux choisir tel ou tel fichier mais il m'extrait toutes les feuilles alors que je n'en voudrais qu'un seule sur chaque classeur et si possible que les 2 feuilles choisies soient fusionner en 1 feuille.... ( Classeur A, je prends la feuille 1 / Classeur B, je prends la feuille 1 et on fusionne les 2 feuilles sur classeur et une feuille à part..)

Merci d'avance pour votre aide

Private Sub CommandButton1_Click()
'On crée une variable 'wbFusion' de type Classeur Excel
Dim wbFusion As Workbook
'On l'associe au classeur à partir duquel tu lances la macro
Set wbFusion = ThisWorkbook

'On crée une variable wbCible qui va correspondre tour à tour aux classeur à importer
Dim wbCible As Workbook
Dim shCible As Worksheet

'Afin de lui affecter des fichiers, l'utilisateur va les sélectionner via une boîte de dialogue
'NOTA : le With XXXXXXXXX évite de répéter plein de fois XXXXXXXXX lorsque l'on parle de la même chose ;)
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Choisissez le(s) classeur(s) à importer"
    .Filters.Add "Classeur Excel", "*.xls,*.xls?" 'on filtre par tous les fichiers .xls et xls? avec '?' signifiant "1 caractère"
    .ButtonName = "Importer ce(s) classeur(s)"
    .AllowMultiSelect = True 'on autorise la sélection multiple
    .Show 'on affiche la fenêtre, on attend le retour de l'utilisateur pour continuer

    'on a réglé la boîte de dialogue, maintenant il faut traiter les données de l'utilisateur :
    'si l'utilisateur n'a pas sélectionné de fichier, on met un message d'erreur
    If .SelectedItems.Count = 0 Then
        MsgBox "Veuillez sélectionner au moins un fichier", vbExclamation, "Erreur"
    'Sinon, on traite :
    Else
        For i = 1 To .SelectedItems.Count
            'On ouvre chaque classeur un par un
            Set wbCible = Workbooks.Open(.SelectedItems(i))
            CouleurOnglet = RGB(Rnd * 255, Rnd * 255, Rnd * 255) 'on va mettre toutes les pages de ce classeur importées avec l'onglet de la même couleur
            CompteurClasseur = CompteurClasseur + 1 'on incrémente un compteur, facultatif
            'Pour chaque feuille du wbCible :
            For Each shCible In wbCible.Sheets
                shCible.Tab.Color = CouleurOnglet
                shCible.Name = Int(Rnd * 99999) 'nom aléatoire pour être certain qu'il n'y ait pas de doublon plantant la macro
                shCible.Copy after:=wbFusion.Sheets(wbFusion.Sheets.Count) 'on la copie à la fin de wbFusion
                CompteurFeuille = CompteurFeuille + 1 'on incrémente un compteur, facultatif
            Next shCible
            'On ferme le classeur sans enregistrer (on a changé le nom des pages avant copie)
            wbCible.Close SaveChanges:=False
        'On passe au classeur suivant
        Next i
        'Facultatif, à l'aide des compteurs, on indique à l'utilisateur que tout s'est bien passé
        MsgBox CompteurFeuille & " feuilles ont bien été importées, provenant de " & CompteurClasseur & " classeurs Excel.", vbInformation, "Import réussi"
    End If
End With

End Sub

Bonjour,

Qu'entendez-vous par fusionner ? Déjà qu'on recommande de ne pas fusionner les cellules, alors fusionner les feuilles ...

Il est possible d'importer toutes les feuilles 1 de tous les classeurs de tous les dossiers, ou de n'importer que les zones utilisées à la suite par exemple sur une seule feuille du classeur de destination.

Si ce sont les zones utilisées qui vous intéressent, il faudrait donner des détails si vous souhaitez récupérer des zones précises.

Cdlt,

Bonjour,

Bon, je viens de m'apercevoir que j'ai dit des bêtises ! en fait, ce serait de sélectionner une zone de chaque feuille (ex A1 : M3) et si possible, les zones sélectionnées se mettraient sur la même feuille et l' un à la suite de l'autre...

J'ai oublié aussi, la possibilité de supprimer les lignes vides dans la zone de sélectionner...

J'en demande beaucoup !!!

Bonjour,

Voici un essai générique avec tous les fichiers à importer contenus dans le même dossier. Le code doit être collé sur le fichier de destination. C'est ce fichier qui exécutera le code alors que tous les fichiers sources seront fermés. Il faut adapter les noms et références à votre vrai problème.

sub test()

dossier = "C:\...\" '<<<< ADAPTER EMPLACEMENT FICHIERS SOURCES
fichier = dir(dossier & "*.xls*")
while fichier <> "" 'tant qu'il existe fichier excel dans dossier
    if fichier <> thisworkbook.name then 'si le fichier est different du classeur executant
        with workbooks.open(dossier & fichier) 'avec ce fichier en cours, tout juste ouvert
            t = .sheets(1).range("A1:M3") 'on extrait la plage désirée
            .close false 'on ferme
        end with
        with thisworkbook.sheets(1) 'avec classeur exec
            nvl = .cells(.rows.count, 1).end(xlup).row + 1 'nvlle ligne
            .cells(nvl, 1).resize(ubound(t), ubound(t, 2)) = t 'collage
        end with
    end if
    fichier = dir 'fichier suivant
wend

'call EffacerVides 'en option à la fin
 
end sub

sub EffacerVides()

with thisworkbook.sheets(1) 'avec feuille 1
    with intersect(.usedrange, .range("A:M")) 'avec colonnes A:M limitées à la zone utilisée
        t = .value 'recup valeurs
        for i = lbound(t) to ubound(t) 'pour chaque ligne
            if t(i, 1) <> "" then 'si la valeur en col 1 n'est pas vide
                n = n + 1 ' incrementation
                for k = lbound(t, 2) to ubound(t, 2) 'pour chaque colonne
                    t(n, k) = t(i, k) 'on recupère les valeurs (ce qui veut dire qu'on n'efface les "lignes" vides)
                next k
            end if
        next i
        .clearcontents 'efface contenu
        if n > 0 then .resize(n, ubound(t, 2)).value = t 'colle nouveau contenu
    end with
end with

end sub

Cdlt,

Bonsoir,

J'ai testé mais le souci, c'est que ne ne peut pas choisir un fichier au hasard car dans votre code ouvre tous le fichiers excel qui sont sur le bureau par exemple...

Peut-être faire un mixe des 2 ? j'essaie

Ca c'est à toi de me dire. Moi je ne peux pas savoir à l'avance quelles seront les conditions d'exécution si je n'ai pas un cadre précis. On peut affiner la recherche des fichiers, on peut les définir sur le classeur et les ouvrir grâce à leur chemin complet, ...

Mais moi je ne suis pas devin

C'est bon, j'ai réussi en mixant vos codes et les autres !

Encore merci !

Houra ! Peux-tu poster le code final dans ce cas ? De mon point de vue, la cohabitation d'une recherche de fichier et d'une boite de dialogue de sélection de fichiers est à éviter. Il est possible de faire de la sélection de dossiers sinon...

Cdlt,