Fusionner plusieurs fichier en un

Bonjour

J'ai essayé plusieurs macro mais sans succès. j'ai plusieurs fichier excel dans un meme fichier et je veux le fusionner en un seul .

Lorsque je roule ce code ... l'erreur 400 apparait et un seul fichier c'est copié.

Sub recup()
Range("A6").Select 'sélectionner la cellule de début
Chemin = "P:\CIUSSS Centre-Ouest-de-LIle-Montreal\3208-Arrimage BD projet GRM Logibec\3208-Divers\BD PROD\BD Travaillé\CUISSS\Produits reserves tous\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xlsx") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("bd_export").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

Bonjour,

Je te propose une autre piste mais assez semblable à ce que tu fais !

Au lieu de copier/coller, j'affecte les valeurs de la plage à une autre plage. Je suis parti du postulat que les plages des différents classeurs ont toutes le même nom à savoir "bd_export" et afin de bien s'y retrouver, j'ai utilisé plusieurs variables objet :

Sub recup()

    Dim Classeur As Workbook
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Chemin As String
    Dim Fichier As String

    Chemin = "P:\CIUSSS Centre-Ouest-de-LIle-Montreal\3208-Arrimage BD projet GRM Logibec\3208-Divers\BD PROD\BD Travaillé\CUISSS\Produits reserves tous\"  'saisir le chemin complet du dossier où se trouvent les fichiers
    Fichier = Dir(Chemin & "*.xlsx") ' Premier fichier

    'feuille où seront collées les valeurs, adapter le nom...
    Set Fe = ThisWorkbook.Worksheets("Feuil1")

    Application.ScreenUpdating = False

    Do While Fichier <> ""

        Set Classeur = Workbooks.Open(Chemin & Fichier)

        'ici, le nom est commun à tous les classeurs
        Set Plage = Classeur.Names("bd_export").RefersToRange

        'recherche la 1ère cellule vide en colonne A
        Set Cel = Fe.Cells(Rows.Count, 1).End(xlUp).Offset(1)

        'si pour la 1ère fois la cellule se trouve au dessus de la cellule A6, défini A6 comme la cellule de départ
        If Cel.Row < 6 Then Set Cel = Fe.Cells(6, 1)

        'récup des valeurs
        Fe.Range(Cel, Fe.Cells(Cel.Row + Plage.Rows.Count - 1, Plage.Columns.Count)).Value = Plage.Value

        Classeur.Close savechanges:=False

        Fichier = Dir ' Fichier suivant

    Loop

    Application.ScreenUpdating = True

End Sub

Interessant ;

Par contre j'ai cette erreur et seulement un fichier s'est "copier".

Merci

Mon erreur J'avais appeler la feuil bd_export au lieu de la plage bd_export

Bonjour,

Comme je suppose que tu ne sais pas sur quelle ligne se produit l'erreur, il te faut dérouler le code avec la touche F8 par appuis successifs sur cette dernière jusqu'à se que l'erreur se produise à nouveau afin que nous ayons une piste !

J'attend ton retour !