Macro Excel 2003 pour compiler des données a partir de plusieurs fichiers

une nouvelle interrogation remet tout à zéro (heu, enfin je pense d'après mes souvenirs, car cette macro remonte à très loin)

Bonjour

J'ai utilisé votre fichier mais j'ai une erreur d’exécution 76

Ça bloque au niveau :

Set Fso = CreateObject("Scripting.FileSystemObject")

Set SourceFolder = Fso.GetFolder(Repertoire)

Dernière ligne en surbrillance

Pourriez vous m'aider SVP

Bonjour samirall2510

Quel fichier ?

A qui t'adresses-tu ?

Peux-tu a minima faire une copie d'écran ?

Vérifie les paramètres du VBE (outils > préférences)

Bonsoir

En fait, j'ai trois fichier (ci-joint) avec les mêmes intitulés de colonnes

Et je voudrais avoir un 4e fichier, qui compile quand on l'ouvre,

les données de ces 3 fichiers avec les mêmes intitulés de colonnes

J'ai essayé avec le fichier proposé (qui date de 2013) mais je me retrouve tous le temps les données de 2017 qui s'affichent

mais pour les 2 autres années, je n'ai que des valeurs d'erreurs qui s'affichent.

Si vous pouvez m'aider SVP

Cordialement.

Bonjour

Puisque tu as 2010 et pas 2003 pourquoi ne pas utiliser PowerQuery, en add on sur 2010 et 2013 et intégré à partir de 2016...

Bonjour Chris

sinon

Option Explicit

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    Dim chemin$, monFichier$, derL%, onglet$

Sub collecter()

    ' à modifier ...
    chemin = ThisWorkbook.Path & "\test\"
    onglet = "Suivi REX"

    Set wbk1 = ThisWorkbook
    Set ws1 = wbk1.Sheets(onglet)
    ws1.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    monFichier = Dir(chemin & "*.xlsx")

    Do While monFichier <> ""
        ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        derL = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        If Not monFichier Like "*.xlsm" Then
            Set wbk2 = Workbooks.Open(chemin & monFichier)
            Set ws2 = wbk2.Sheets(onglet)
            ws2.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells.Copy
            ws1.Paste
            Application.DisplayAlerts = False
                wbk2.Close False
            Application.DisplayAlerts = True
            Rows(derL).Delete Shift:=xlUp
        End If
        monFichier = Dir
    Loop

End Sub

ATTENTION, il faut que tu modifies cette ligne selon l'endroit où tes fichiers sont stockés

chemin = ThisWorkbook.Path & "\test\"