Boucle Extraire donnés d'un fichier dans onglet de même nom

[JVOS]

Bonjour à tous
J'ai plusieurs fichiers sources qui se nomment 1, 2, 3.
Chaque ficher à une seule Feuille. Tous les fichiers sont dans un seul dossier.
Je dois récupérer dans un fichier Cible les colonnes "A😀" de chaque fichier dans la feuille ayant le même nom que le fichier source.
En pratique :
J'ouvre mon Fichier ("1")
Je sélectionne mes colonnes ("A😀")
J'active mon fichier Cible
Je colle en B1 dans la Feuille ("1")
Je ferme le Fichier ("1")
Et je passe au suivant avec le Fichier ("2") et Feuille ("2") du fichier cible.

J'ai pas beaucoup d’expérience en VBA et j'ai pas pu aboutir
Aidez moi svp

Private Sub Workbook_Open()

Chemin = "C:\Users\HP\Documents\TEST"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("A😀").Select
Selection.Copy
ThisWorkbook.Activate
ActiveSheet.Paste Destination:=Worksheets(Fichier).Range("B1")
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
Fichier = Dir ' Fichier suivant
Loop

End Sub

 

[sousou]

Bonjour
pas besoin de sélectionner pour copier coller
manque un antislash pour accéder au fichier
essai ceci, mais pas testé.
Private Sub Workbook_Open()
Chemin = "C:\Users\HP\Documents\TEST\"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
set source= Workbooks.Open (Chemin & Fichier)
source.colums(1).copy=thisworkbook.sheets(Fichier).columns(2)
source.save savechange:=false
Fichier = Dir ()' Fichier suivant
Loop

End Sub

 

[JVOS]

Bonjour Sousou
Pour
source.colums(1).copy=thisworkbook.sheets(Fichier).columns(2)
Ça m'indique "L'indice n’appartient pas à la sélection"

J'ai joints les fichiers

Merci pour ton aide

 

[Staple1600]

Bonjour le fil, JVOS, sousou

JVOS (sousou étant déconnecté, je me permets de répondre 😉)
Une petite coquille (il manque un n)
source.columns(1).copy=thisworkbook.sheets(Fichier).columns(2)

 

[JVOS]

Bonjour Staple1600
J'ai fais la correction mais j'ai toujours la même erreur 9
Cordialement

 

[Staple1600]

Re

Et l'erreur est toujours sur la même ligne de code ?

 

[JVOS]

Re
Oui toujours la même ligne
Source.Columns(1).Copy = ThisWorkbook.Sheets(Fichier).Columns(2)

Cd

 

[Staple1600]

Re

Test OK sur mon PC avec ces modifs

Private Sub Workbook_Open()
Dim Chemin$, Fichier$, Nom$, source As Workbook
Chemin = "C:\Users\STAPLE\Documents\TESTS\"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
Nom = Split(Fichier, ".")(0)
Set source = Workbooks.Open(Chemin & Fichier)
source.Sheets(1).Columns(1).Copy ThisWorkbook.Sheets(Nom).Columns(2)
Application.CutCopyMode = False
source.Close False
Fichier = Dir() ' Fichier suivant
Loop
End Sub

NB: Pense à remettre le bon chemin dans le code.

 

[JVOS]

Merci Staple1600
Il y a juste une info qui s'est perdu en route
Je dois copier toutes les colonnes remplis du fichier source, soit ici 4 colonnes, et les coller à partir de la colonne 2

 

[JVOS]

Merci beaucoup Staple1600
J'ai résolu mon problème en insérant un For i

Private Sub Workbook_Open()

Dim Chemin$, Fichier$, Nom$, source As Workbook
Dim i As Integer

Chemin = "C:\Users\HP\Documents\TEST\"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
Nom = Split(Fichier, ".")(0)
Set source = Workbooks.Open(Chemin & Fichier)
For i = 1 To 4
source.Sheets(1).Columns(i).Copy ThisWorkbook.Sheets(Nom).Columns(i + 1)
Next i
Application.CutCopyMode = False
source.Close False
Fichier = Dir() ' Fichier suivant
Loop
End Sub

 

[Staple1600]

Re

C'est la faute à l l'emoticone dans le message#1 qui nous a foutu dedans, palsambleu!
Si j'avais lu ceci, alors les choses eurent été différentes

Je dois récupérer dans un fichier Cible les colonnes "A:D" de chaque fichier dans la feuille ayant le même nom que le fichier source.

 

[Staple1600]

Re

Je t'aurais alors proposé cette syntaxe 😉

Private Sub Workbook_Open()
Dim Chemin$, Fichier$, Nom$, source As Workbook
Chemin = "C:\Users\STAPLE\Documents\TEST\"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
Nom = Split(Fichier, ".")(0)
Set source = Workbooks.Open(Chemin & Fichier)
source.Sheets(1).Range("A:D").Copy ThisWorkbook.Sheets(Nom).Range("A:D")
Application.CutCopyMode = False
source.Close False
Fichier = Dir() ' Fichier suivant
Loop
End Sub

EDITION: Ah revoilou, sousou (salutations du soir) 😉

 

[JVOS]

Dans tous les cas merci beaucoup pour votre aide et du temps que vous y consacrez
Heureusement que vous êtes là pour nous

 

[SebSemdee]

Le plus efficace serait de passer à power query pour mettre en place une requête qui aspire tous les fichiers en un clic et sans aucune macro

 

[JVOS]

Bonjour SebSemdee
J'ai installé PowerQuery
Mais mes fichiers .xls ne peuvent être ouvert car « La table externe n'est pas dans le format attendu. »
Il y a des entête de colonne vide
Cd