VBA comment récupérer les données de plusieurs fichiers excel.
icecube
-
gbinforme Messages postés 15481 Date d'inscription Statut Contributeur Dernière intervention -
gbinforme Messages postés 15481 Date d'inscription Statut Contributeur Dernière intervention -
bonjour,
j'ai une macro qui permet d'ouvrir une boite de dilaogue celle ci me permet de sélectionner un fichier excel, cette macro ouvre le fichier pour appliquer un filtre sur la feuil "codax" et elle copie le résultat du filtre et le coller sur le fichier où la macro est écrite (feuil1).
du coup aujourd'hui on me demande de faire on sorte de pouvoir sélectionner plusieurs fichiers on va dire 30 et la macro fera la même chose.
pouvez m'aider car même si j'ai mis le multiselect a true, ca me preen unisuement les données du premier ficher donc les 29 autre ne sont meme pris en compte par la macro. En vous remrciant para avance
j'ai une macro qui permet d'ouvrir une boite de dilaogue celle ci me permet de sélectionner un fichier excel, cette macro ouvre le fichier pour appliquer un filtre sur la feuil "codax" et elle copie le résultat du filtre et le coller sur le fichier où la macro est écrite (feuil1).
du coup aujourd'hui on me demande de faire on sorte de pouvoir sélectionner plusieurs fichiers on va dire 30 et la macro fera la même chose.
pouvez m'aider car même si j'ai mis le multiselect a true, ca me preen unisuement les données du premier ficher donc les 29 autre ne sont meme pris en compte par la macro. En vous remrciant para avance
Option Explicit
Sub ouvrirtest()
Application.EnableEvents = False
'Application.Calculation = xlCalculateManual
Dim wbsrc As Excel.Workbook ' déclarer le fichier source
Dim wbtrg As Excel.Workbook ' déclarer le fichier detinataire
Dim ws As Excel.Worksheet ' declarer les feuil
Dim strFileName As String
Dim intChoice As Integer 'Déclarer les variables de base
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Workbooks.Open strFileName
Set wbsrc = ActiveWorkbook
Else
MsgBox "La procédure est annulée car aucun fichier n’a été entré."
Exit Sub
End If
'Set wbsrc = Application.Workbooks.Open("C:\Users\tabello\Mes documents locaux\outil compta-risk\F_Comparaison\COMPARISON_1505.xlsx") ' ouvrir le fichier source
Set wbtrg = ThisWorkbook ' dire que c'est sur ce fichier que je travail
Set ws = wbsrc.Worksheets("CODAX") ' lancer le filtre sur la colonne 4
ws.Range("A6:T400").AutoFilter Field:=3, Criteria1:=RGB(130, 190, 0), Operator:=xlFilterCellColor
ws.Range("A6:W400").Copy ' copie le résultat du filtre
Set ws = wbtrg.Worksheets("Feuil1") ' coller le resultat dans la feuil source du fichier destinataire
ws.Range("A1").PasteSpecial xlPasteAll
ws.Columns("A:T").ColumnWidth = 15
ws.Rows("1:1").RowHeight = 70
ws.Rows("2:100").RowHeight = 15
Set ws = Nothing
Application.DisplayAlerts = False
wbsrc.Close savechanges:=False ' fermer le fichier source
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wbsrc = Nothing
Set wbtrg = Nothing
Application.Cursor = xlDefault
'ActiveWorkbook.Sheets("PAGE d'ACCUEIL").Activate
'Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Import terminé"
End Sub
A voir également:
- Récupérer des données dans plusieurs fichiers excel
- Trier des données excel - Guide
- Liste déroulante excel - Guide
- Recuperer message whatsapp supprimé - Guide
- Formule moyenne excel plusieurs colonnes - Guide
- Renommer des fichiers en masse - Guide
3 réponses
Bonjour,
Il te faut faire une boucle sur SelectedItems(x) avec x = 1 to SelectedItems.count pour récupérer tous les classeurs choisis.
Il te faut faire une boucle sur SelectedItems(x) avec x = 1 to SelectedItems.count pour récupérer tous les classeurs choisis.
bonjour, merci pour ta réponse!
est ce que tu peux intégrer cet boucle dans ma macro, car je suis très mauvais lorsqu'il faut écrire des boucles.
merci
est ce que tu peux intégrer cet boucle dans ma macro, car je suis très mauvais lorsqu'il faut écrire des boucles.
merci
Bonsoir,
Ta macro avec la boucle :
Ta macro avec la boucle :
Option Explicit
Sub ouvrirtest()
Application.EnableEvents = False
Dim wbsrc As Excel.Workbook ' déclarer le fichier source
Dim wbtrg As Excel.Workbook ' déclarer le fichier detinataire
Dim ws As Excel.Worksheet ' declarer les feuil
Dim wk As Excel.Worksheet ' declarer les feuil
Dim intChoice As Integer 'Déclarer les variables de base
Dim fic As Integer
Application.ScreenUpdating = False
Application.Cursor = xlWait
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
intChoice = .Show
If intChoice <> 0 Then
Set wbtrg = ThisWorkbook ' dire que c'est sur ce fichier que je travail
Set ws = wbtrg.Worksheets("Feuil1") ' coller le resultat dans la feuil source du fichier destinataire
For fic = 1 To .SelectedItems.Count
Workbooks.Open .SelectedItems(fic)
Set wbsrc = ActiveWorkbook
Set wk = wbsrc.Worksheets("CODAX") ' lancer le filtre sur la colonne 4
wk.Range("A6:T400").AutoFilter Field:=3, Criteria1:=RGB(130, 190, 0), Operator:=xlFilterCellColor
wk.Range("A6:W400").Copy ' copie le résultat du filtre
ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Paste
wbsrc.Close savechanges:=False ' fermer le fichier source
Next fic
ws.Columns("A:T").ColumnWidth = 15
ws.Rows("1:1").RowHeight = 70
ws.Rows("2:100").RowHeight = 15
Set ws = Nothing
Set wbsrc = Nothing
Set wbtrg = Nothing
Else
MsgBox "La procédure est annulée car aucun fichier n’a été entré."
Exit Sub
End If
End With
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.EnableEvents = True
MsgBox "Import terminé"
End Sub