Créer une boucle pour importer des fichiers
bonjour à tous,
je suis a la recherche d'aide pour créer une boucle sur ma macro,
pour le moment j'ai fait ma macro qui recupere des données pour les mettre dans un fichier recap,
cependant j'ai 25 fichiers et j'ai donc recopier le meme schema 25 fois, oui je sais je suis debile lol,
je sais qu'il existe un systeme de boucle avec la fonction dir mais mon probleme est le suivant :
mes fichiers sources comportent plusieurs onglets avec des noms differents, d'ou le fait que je ne sais pas comment ecrire cette boucle !!
Merci d'avance a tous pour votre aide
Bonjour et bienvenu(e)
Fournis ton fichier ainsi que la macro et explique un peu plus ton histoire de feuilles
Que tu ne connaisses pas le nom des feuilles dans lesquelles tu veux récupérer des données, possible mais tu dois bien savoir comment trouver ces feuilles (position dans le classeur, repérage dans la feuille etc .... ou tirage au sort
Bonjour,
Une piste :
Sub Test()
Dim Cls As Workbook
Dim Fe As Worksheet
Dim Tablo() As String
Dim I As Integer
'appel de la fonction avec le chemin du dossier (adapter...)
Tablo = RecupFichiers("F:\")
If Not (Not Tablo) Then
For I = 1 To UBound(Tablo)
'ouvre le classeur...
Set Cls = Workbooks.Open(Tablo(I))
'parcours sa collection de feuilles...
For Each Fe In Cls.Worksheets
'inscrit le nom des feuilles dans la fenêtre d'exécution (Ctrl+G)
Debug.Print Fe.Name
'c'est ici qu'il te faut savoir quoi faire du genre...
' If Fe.Name = "Le nom de ma feuille" Then
' MsgBox Fe.Range("A1").Value
' End If
Next Fe
'referme le classeur
Cls.Close False
Next I
End If
End Sub
Function RecupFichiers(Chemin As String) As String()
Dim Tbl() As String
Dim Fichier As String
Dim I As Integer
'seulement les fichiers Excel (.xls, . xlsx, . xlsm, etc...)
Fichier = Dir(Chemin & "*.xls*")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fichier
Fichier = Dir()
Loop
RecupFichiers = Tbl()
End Functionbonjour,
Merci pour vos retours,
je vous donne un aperçu de ma macro ci-dessous,
les feuilles font parti d'un classeur avec 3 a 10 onglets max.
Sub Creationsynthese()
' effacement de la feuille
Cells.Delete
' A)fichier 1
'ouverture des fichiers
Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\23-grille budgetaire BP 2016.xlsx"
Application.DisplayAlerts = False
'selection des données (copier coller)
Workbooks("23-grille budgetaire BP 2016.xlsx").Sheets("23 (2)").UsedRange.Select
Workbooks("23-grille budgetaire BP 2016.xlsx").Sheets("23 (2)").UsedRange.Copy
Workbooks("récap.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count
Range("A" & ActiveSheet.UsedRange.Rows.Count).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
'fermeture des fichiers
Workbooks("23-grille budgetaire BP 2016.xlsx").Close savechanges:=False
' B) fichier 2
'ouverture des fichiers
Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\24-grille budgetaire BP 2016.xlsx"
Application.DisplayAlerts = False
'selection des données (copier coller)
Workbooks("24-grille budgetaire BP 2016.xlsx").Sheets("24 (2)").UsedRange.Select
Workbooks("24-grille budgetaire BP 2016.xlsx").Sheets("24 (2)").UsedRange.Copy
Workbooks("récap.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False 'vider le presse papier
Application.DisplayAlerts = False
'fermeture des fichiers
Workbooks("24-grille budgetaire BP 2016.xlsx").Close savechanges:=False
' B) fichier 3
'ouverture des fichiers
Workbooks.Open "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\25-grille budgetaire BP 2016.xlsx"
Application.DisplayAlerts = False
'selection des données (copier coller)
Workbooks("25-grille budgetaire BP 2016.xlsx").Sheets("25 (2)").UsedRange.Select
Workbooks("25-grille budgetaire BP 2016.xlsx").Sheets("25 (2)").UsedRange.Copy
Workbooks("récap.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False 'vider le presse papier
Application.DisplayAlerts = False
'fermeture des fichiers
Workbooks("25-grille budgetaire BP 2016.xlsx").Close savechanges:=False
End sub
Bonjour
Sans fichier pour tester
Sub CreationSynthese()
Dim Chemin As String, Fichier As String, Feuille As String
Dim Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = ActiveSheet
' effacement de la feuille
Ws.Cells.Delete
Chemin = "M:\CCIE\BUDGETS\PRIMITIF\2016\préparation BP 2016 - provisoire\Appui\test\"
Fichier = Dir(Chemin & "*-grille budgetaire BP 2016.xlsx")
Do While Fichier <> "" ' Commence la boucle.
Feuille = Left(Fichier, 2) & " (2)"
With Workbooks.Open(Chemin & Fichier)
.Sheets(Feuille).UsedRange.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
.Close savechanges:=False
End With
Fichier = Dir ' Extrait l'entrée suivante.
Loop
End SubBanzai,
Je n'ai qu'une chose à te dire .... Tu dechires tout !!! merci t vraiment un boss,
j'ai tester, c top!!