Extraire données dans plusieurs fichiers Excel présents dans un dossier
Bonjour à tous,
Je suis débutante sur VBA et je rencontre qq difficultés pour mettre en place une macro qui me permettrait d'extraire des données présents dans des formulaires excel, et qui sont stockés dans un même dossier.
Je m'explique plus en détail:
Je dispose d'un dossier "formulaires" qui est alimenté automatiquement par de nouveaux fichiers.
Je souhaiterai donc lorsqu'un nouveau fichier arrive dans ce dossier, que celui-ci soit ouvert et que des lignes spécifiques soit copiées, puis collées en transposant dans un autre fichier excel (feuille 3).
Je vous mets ci-dessous ce que j'ai réalisé avec des solutions que j'ai trouvé et que j'ai tenté d'adapter à mon problème. Mais cela ne fonctionne pas
Option Explicit
Sub Import_données()
'
' Import_données Macro
Dim principal As Feuil3
Dim repertoire As String, fichier As String
Application.ScreenUpdating = False
Set principal = Feuil3
repertoire = "C:\\Formulaires reçus"
ChDir repertoire
fichier = Dir("*.xlsx")
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
With Sheets("Feuil1")
On Error GoTo 0
On Error Resume Next
Range("D7,D9,D10,D11,D15,D25,D28,D38,D39,D40,D48,D58,D61,D62,D66,D67,D72,D74,D82,D83,D84,D94,D95,D108,D109,D110,D111,D112,D113,D114,D115,D116,D117,D118,D119,D120").Select
Range("D120").Activate
Selection.Copy
Windows("Suivi demandes.xlsx").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
ActiveWorkbook.Close False
End If
suivant:
If Err.Number = 9 Then MsgBox "Problème formulaire" & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
End Sub
Merci par avance pour vos éclaircissements et pour votre aide