Importer depuis plusieurs classeurs
Résolu
Bonjour les amis
j'ai pour but d'importer des données depuis d'autres classeurs qui se trouve dans
un même dossier mais la macro que je possède ne peut importer que d'un seul classeur
le but de la macro que cherche c'est qu'elle m'autorise à sélectionner tout
les fichiers excel que je désire et les importer dans dans le classeur source
et coller les un sous l'autre pour former un seul tableau
voila la macro que je veux ameliorer
Sub impt_data()
Application.ScreenUpdating = False
Dim Fich As String,
Fich = Application.GetOpenFilename
Workbooks.Open (Fich)
dim i as long
i = Cells(Rows.Count, 1).End(xlUp).Row
cd = ActiveSheet.Range("A5:Li")
ActiveWorkbook.Close
Range("A5:Li") = cd
End Sub
et merci d'avance
j'ai pour but d'importer des données depuis d'autres classeurs qui se trouve dans
un même dossier mais la macro que je possède ne peut importer que d'un seul classeur
le but de la macro que cherche c'est qu'elle m'autorise à sélectionner tout
les fichiers excel que je désire et les importer dans dans le classeur source
et coller les un sous l'autre pour former un seul tableau
voila la macro que je veux ameliorer
Sub impt_data()
Application.ScreenUpdating = False
Dim Fich As String,
Fich = Application.GetOpenFilename
Workbooks.Open (Fich)
dim i as long
i = Cells(Rows.Count, 1).End(xlUp).Row
cd = ActiveSheet.Range("A5:Li")
ActiveWorkbook.Close
Range("A5:Li") = cd
End Sub
et merci d'avance
5 réponses
-
Bonjour,
Essaie :Sub impt_data() Application.ScreenUpdating = False Dim Fich As String Do While Fich <> "Faux" Fich = Application.GetOpenFilename Workbooks.Open (Fich) Dim i As Long i = Cells(Rows.Count, 1).End(xlUp).Row + 1 cd = ActiveSheet.Range("A5:Li") ActiveWorkbook.Close False Range("A5:Li") = cd Loop End Sub
Daniel -
Elle ne permet pas de sélectionner plusieurs fichiers à la fois. Après chaque fichier, elle demande le classeur à ouvrir. Quant à l'erreur, regarde la valeur de "i". Il faudrait aussi préciser la feuille avec laquelle tu veux travailler.
Daniel -
Sub impt_data() Application.ScreenUpdating = False Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range Dim Wbk As Workbook Set Sh = ThisWorkbook.Sheets("data") Fich = Application.GetOpenFilename Do While Fich <> "Faux" L = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1 Set Wbk = Workbooks.Open(Fich) With Wbk.Sheets("data") I = .Cells(Rows.Count, 1).End(xlUp).Row Set CD = .Range("A5:L" & I) Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value Wbk.Close False End With Loop End Sub
Daniel -
salut daniel et merci pour votre effort
le code s’arrête au niveau de la 5 eme ligne : Set Sh = ThisWorkbook.Sheets("data")
j'ai essayé le code que vous avez posté hier tout en le modifiant un un peu il efficace mais je préfére utiliser "Application.GetOpenFilename" pour selectionner d'un seul coup tout les fichiers excel dans le dossier contenant pour les mettre l'un sous l'autre pour former un seul tableau :
Sub impt_data()
Application.ScreenUpdating = False
Dim Fich As String
Do While Fich <> "Faux"
Fich = Application.GetOpenFilename
Workbooks.Open (Fich)
Dim i As Long
i = Cells(Rows.Count, 2).End(xlUp).Row + 1
CD = ActiveSheet.Range(Cells(5, 1), Cells(i, 12))
ActiveWorkbook.Close False
Dim j As Long
j = Cells(Rows.Count, 2).End(xlUp).Row + 1
Range(Cells(5 + j, 1), Cells(i + j, 12)) = CD
Loop
End Sub-
Voici la boucle sur les choix de fichiers :
Application.ScreenUpdating = False Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range Dim Wbk As Workbook, Coll Set Sh = ThisWorkbook.Sheets("data") Coll = Application.GetOpenFilename(, , , , True) If Coll Is Nothing Then Exit Sub For I = 1 To UBound(Coll) Fich = Coll(I) Set Wbk = Workbooks.Open(Fich) Next
Pour le reste, ca dépend si le classeur est celui qui contient la macro. Fais-moi parvenir ce dernier.
Daniel
-
-
salut
j'ai envoyé dans ce lien un exemple des fichiers et du dossier pour que vous puissier tester la macro
merci encore une fois
https://www.cjoint.com/c/HGElqxPzkoi-
Sub impt_data() Application.ScreenUpdating = False Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range Dim Wbk As Workbook, Coll, K As Long Set Sh = ThisWorkbook.Sheets("data") Coll = Application.GetOpenFilename(, , , , True) For K = 1 To UBound(Coll) Fich = Coll(K) Set Wbk = Workbooks.Open(Fich) L = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1 With Wbk.Sheets("data") I = .Cells(.Rows.Count, 2).End(xlUp).Row Set CD = .Range("A5:L" & I) Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value Wbk.Close False End With Next K End Sub
Daniel -
-
Tu as raison :
Sub impt_data() Application.ScreenUpdating = False Dim Fich As String, Sh As Worksheet, I As Long, L As Long, CD As Range Dim Wbk As Workbook, Coll, K As Long Set Sh = ThisWorkbook.Sheets("data") Coll = Application.GetOpenFilename(, , , , True) For K = 1 To UBound(Coll) Fich = Coll(K) Set Wbk = Workbooks.Open(Fich) L = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row + 1 With Wbk.Sheets("data") I = .Cells(.Rows.Count, 2).End(xlUp).Row Set CD = .Range("A5:L" & I) Sh.Cells(L, 1).Resize(CD.Rows.Count, 12).Value = CD.Value Wbk.Close False End With Next K End Sub
Daniel -
-
