Fusion plusieur classeur en 1 seul sous forme de feuilles

Bonjour,

Je vais essayer d'^tre le plus clair possible pour exprimer mon besoin.

J'ai un certain nombre de fichier (de 2 à 180).

C'est fichier n'ont qu'une seule feuille (1 onglet).

Je souhaiterai qu'une macro crée un fichier avec une feuille pour chaque fichier et son contenu.

le nom de l'onglet serait le nom du fichier.

Si plus de précision me dire.

MERCI

@+++

Bonjour

Regroupe tous les fichiers excel sous le même classeur et insère celui-ci également

bonjour,

une proposition via une macro. La macro reprend la première feuille de chaque fichier .xlsx qui se trouve dans le répertoire indiqué dans la variable chemin.

Sub aargh()
  Set twb = ThisWorkbook
  chemin = "d:\downloads\" ' à adapter
  n = Dir(chemin & "*.xlsx")
  While n <> ""
   Set wb = Workbooks.Open(n)
   wb.Sheets(1).Copy after:=twb.Sheets(twb.Sheets.Count)
   wb.Close False
   ActiveSheet.Name = Left(n, 30)
   n = Dir()
  Wend
End Sub

Steelson a écrit :

Bonjour

Regroupe tous les fichiers excel sous le même classeur et insère celui-ci également

Bonjour,

Excuse mais je ne comprends pas :

"Regroupe tous les fichiers excel sous le même classeur"

MERCI

Les fichiers excel (xlsx) que tu veux regrouper doivent se trouver dans le même répertoire que le fichier que j'ai posté.

Steelson a écrit :

Les fichiers excel (xlsx) que tu veux regrouper doivent se trouver dans le même répertoire que le fichier que j'ai posté.

Re-Bonsoir,

Je viens de trouver la raison pour laquelle cela ne fonctionnait pas !

En faites mes fichiers sont enregistrés en : Classeur Microsoft Excel 5.0/95 (*.XLS)

Y-at-il possibilités que cela fonctionne avec cette extension ?

Ou sinon y-t-il possibilités des les convertir tous à la fois sous cette extension car j'en ai environ 140 à 150 !

Donc hyper long à faire 1 par 1.

MERCI

@++++

Bonjour,

Modifie ainsi, la proposition de h2so4 (que je salue).

Cdlt.

 n = Dir(chemin & "*.xls")

ok

Option Explicit

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim chemin$, monFichier$

Sub collecter()
    Set wbk1 = ThisWorkbook

    chemin = ThisWorkbook.Path & "\"
    monFichier = Dir(chemin & "*.xls")

    Do While monFichier <> ""
        If Not monFichier Like "*.xlsm" Then
            Set wbk2 = Workbooks.Open(chemin & monFichier)
            Cells.Copy
            With wbk1
                .Sheets.Add After:=.Worksheets(.Worksheets.Count())
                .ActiveSheet.Paste
                .ActiveSheet.Name = monFichier
            End With
            Application.DisplayAlerts = False
                wbk2.Close False
            Application.DisplayAlerts = True
        End If
        monFichier = Dir
    Loop

End Sub

Steelson a écrit :

ok

Option Explicit

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim chemin$, monFichier$

Sub collecter()
    Set wbk1 = ThisWorkbook

    chemin = ThisWorkbook.Path & "\"
    monFichier = Dir(chemin & "*.xls")

    Do While monFichier <> ""
        If Not monFichier Like "*.xlsm" Then
            Set wbk2 = Workbooks.Open(chemin & monFichier)
            Cells.Copy
            With wbk1
                .Sheets.Add After:=.Worksheets(.Worksheets.Count())
                .ActiveSheet.Paste
                .ActiveSheet.Name = monFichier
            End With
            Application.DisplayAlerts = False
                wbk2.Close False
            Application.DisplayAlerts = True
        End If
        monFichier = Dir
    Loop

End Sub

Bonjour,

J'ai testé ce matin et c'est tout à fait ce que je recherché

Encore MERCI

@+++

Merci pour ce retour.