Récupérer valeurs depuis plusieurs fichiers

Bonjour ici !

Pour un besoin de reporting tout bête, je planche sur un vba basé sur un exemple du forum.

Mon besoin : Récupérer le contenu des cellules C2/D2/E2/F2 des feuilles "portables" et "fixes" depuis une 100ène de fichier XLSX.

Et coller le tout dans un fichier "recap" vers les cellules A1/B1/C1/D1 de la feuille "SN".

J'ai essayé quelque le code ci-dessous, mais il ne ce passe rien...

Sub Transferer()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = True

Chemin = ThisWorkbook.Path
FName = Dir(Chemin & "\" & "*.xlsx")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Lg = 10

For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "RECUP.XLSM" Then
Workbooks.Open Filename:=Chemin & "/" & NomFichier

On Error Resume Next

With Workbooks(NomFichier)
.Sheets("portables").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
.Sheets("portables").Range("D2").Copy ThisWorkbook.Sheets("SN").Range("B" & Lg)
.Sheets("portables").Range("E2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("portables").Range("F2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("fixes").Range("C2").Copy ThisWorkbook.Sheets("SN").Range("A" & Lg)
.Sheets("fixes").Range("D2").Copy ThisWorkbook.Sheets("SN").Range("B" & Lg)
.Sheets("fixes").Range("E2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)
.Sheets("fixes").Range("F2").Copy ThisWorkbook.Sheets("SN").Range("C" & Lg)

.Close

Lg = Lg + 1

End With
End If

Next

End Sub

Si vous avez une idée ? Ne serais-ce qu'une petite piste

Un grand merci !!!

Kreg

No idea ? Même petite ^^

Bonsoir

Remplaces cette ligne

Workbooks.Open Filename:=Chemin & "/" & NomFichier

par celle-ci

Workbooks.Open Filename:=Chemin & "\" & NomFichier

Si toujours rien enlèves la ligne

On Error Resume Next

Lances la macro et vérifies si un message d'erreur

Hello !

Bien vu pour la boutade

Malheureusement cela ne change rien.

Ce ci dis, je vois bien qu'en débogage il ne passe pas ma ligne

Workbooks.Open Filename:=Chemin & "\" & NomFichier

Je creuse!

Bonjour

On avance

Kreg a écrit :

Ce ci dis, je vois bien qu'en débogage il ne passe pas ma ligne

Message d'erreur ?

Places une instruction avant l'ouverture du fichier

If Not Fichier.Name = "RECUP.XLSM" Then
MsgBox "Ouverture " & Chemin & "\" & NomFichier
Workbooks.Open Filename:=Chemin & "\" & NomFichier

Et vérifies la conformité des variables (chemin complet-extension du fichier etc ...)

Donc pour résumer :

> non pas de message d'erreur, rien ne ce passe tout simplement...

> en plaçant le flag via la messagebox, il m'indique qu'il ouvre "c:\monchemin\recup.xlsm"

Donc en gros il ne lis pas l'ensemble de mes fichiers .xlsx, mais que mon recup.xlsm qui lui est vide ?

Bonjour

Si je te suis

La macro essaie d'ouvrir ton fichier déjà ouvert et sans message ?

Bizarre autant qu'étrange

Tu as toujours la ligne "On Error Resume Next" de supprimée ?

Ton test il faut le modifier

If Not Ucase(Fichier.Name) = "RECUP.XLSM" Then
MsgBox "Ouverture " & Chemin & "\" & NomFichier
Workbooks.Open Filename:=Chemin & "\" & NomFichier

Après je ne sais pas

Il faut ton fichier principal + 1 fichier que tu dois ouvrir

Bonjour,

Bonjour Banzai,

J'interviens sur ton fil, Banzai, mais en lisant juste une idée pour Kreg

Essaie en changeant la ligne

If Not Fichier.Name = "RECUP.XLSM" Then

par

If Not UCase(Fichier.Name) = "RECUP.XLSM" Then

Refais l'essai demandé par Banzai.

Amicalemen

Bonjour à tous,

Désolé mais je ne m'en sort toujours pas... Maintenant j'obtiens une erreur 91

Je pense avoir suivi vos conseils, nettoyé mon code. Toujours pareil.

Du coup j'ai uploadé un exemple simple, si vous trouvez une coquille

2 fichiers xlsx contenant mes données

1 fichier xlsm "recup.xlsm" fichier qui censé récupéré mes données de mes 2 fichiers xlsx...

Merci

Bonjour

A tester

Tu es mon héros

Un grand merci, fonctionne impec !!!

Problème résolu, j'édite

Merci encore !!