Macro copie feuile classeur vers un autre classeur

Bonjour à tous,

Je suis en train de faire une macro pour copier les données de l'onglet b de plusieurs classeurs et compiler l'ensemble des données vers un autre classeur sur une seule feuille.

En gros :

Prendre les données de l'onglet b des

Fichier 1 : onglet a, b, c

Fichier 2 : onglet a, b, c

Fichier 3 : onglet a, b, c

Fichier 4 : onglet a, b, c

Copier les données les unes à la suite des autres dans

Fichier 5 : onglet compilation

J'ai un soucis, quand je lance ma macro rien ne se passe. Je n'ai pas de message d'erreur mais cela ne fonctionne pas. Pourriez-vous m'éclairer sur le sujet ?

Merci d'avance,

Hugo

Option Explicit

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long

  Set WbDest = ActiveWorkbook

  Chemin = "C:\Users\hfieve\Documents\Test compil macro"
  NomFichier = Dir(Chemin & "*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

  Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    Set WksNewSheet = WbSource.Sheets("positionnement-etude") 'sélectionne la feuille de données à importer positionnement-etude
    WksNewSheet.Activate                        'active cette feuille
    WksNewSheet.Select
    Range("A5:B120").Select    'selection des données que l’on veut importer
    Selection.Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    I = ActiveSheet.UsedRange.Rows.Count        'compte le nombre de lignes déjà utilisées dans ce fichier
    Cells(I + 1, 1).Select                      'sélection de la cellule où on veut coller les données (la première vide)
    ActiveSheet.Paste                           'colle les données
    WbSource.Close                              'ferme le fichier source
    NomFichier = Dir                            'va vers le fichier suivant à importer
  Loop                                          'recommece la boucle avec le fichier suivant
  WbDest.Activate

End Sub

Bonjour Hugo156

coller les données (la première vide)

ActiveSheet.Paste 'colle les données

WbSource.Close 'ferme le fichier source

NomFichier = Dir 'va vers le fichier suivant à importer

Loop 'recommence la boucle avec le fichier

Après ActiveSheet.Paste

j'ajouterais la ligne

Application.CutCopyMode = False

Afin de terminer ton opération de copie sur ce fichier.

Ensuite NomFichier = Dir

Là je comprends moins. Dir est ici une variable.

Ajoute une ligne avec un Stop afin d'arrêter le programme et regarde en survolant avec la souris cette variable Dir quelle valeur a t-elle?

Bonjour Xcellus,

La valeur Nom fichier est égale à " ". Normalement, elle devrait être au fichier qu'elle va importer non ?

dans mon exemple je l'ai appelé fichier 1.

A nouveau,

Dir est considérée ici comme une variable et elle est utilisée pour la 1ière fois. Donc elle est vide.

Plus haut dans ton code il y a

NomFichier = Dir(Chemin & "*.xls")

Effectivement là tu auras un premier fichier (par ordre alphabétique) qui sera dans NomFichier.

Donc ton Do While NomFichier <> "" ne sera pas vide.

et le programme continuera. Mais ensuite tu donnes à NomFichier du vide. Donc ta boucle s'arrête.

Bon, j'ai testé plusieurs possibilités mais toujours rien. J'ai toujours une feuille blanche.

Je dois bien avouer ne pas tout comprendre

Bonjour Hugo156,

Je te laisse un exemple qui va pouvoir te servir pour ton besoin.

Sub AffInfoFichier()
Dim fs, d, f, s
    Chemin = "C:\Users\hfieve\Documents\Test compil macro"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Chemin)
    Set fc = f.Files
    For Each fich In fc
    If fich Like "*.xls" Then
        s = s & fich.Name
        s = s & vbCrLf
    End If
    Next
    MsgBox s
End Sub

Tu le teste. Puis après tu l'adapte à ton code.

Sinon tu reviens vers moi si souci.

Bonne continuation.

A nouveau.

Dans ton code proposé. Avant le Loop fait la correction sur Nom Fichier = Dir

Par

Nom Fichier = Dir()

Pour ainsi faire référence au chemin cité plus haut dans le programme.

Bonne continuation.