1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
|
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig As Integer
Lig = 2
' Le dossier à analyser
strDossier = "C:\Results"
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
' Afficher le nom du fichier dans la fenêtre Exécution
Debug.Print strFichier
' Fichier suivant
strFichier = Dir
If (strFichier <> "") Then
Lig = Lig + 1
ActiveSheet.Cells(Lig, 1) = strFichier
Set appxl = CreateObject("Excel.application")
With appxl
.Workbooks.Open strDossier & "\" & strFichier
.Visible = False
End With
Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
Set fichier = appxl.Windows(strFichier)
Set feuille = appxl.Sheets(Nom_feuille)
feuille.Unprotect ""
'feuille.Range("B14", "B20").Copy Destination:=Windows("Controle.xlsm").Range("H3", "H9")
'feuille.Range("B14", "B20").Copy Workbooks("Controle.xlsm").Sheets(1).Range("H3")
feuille.Activate
feuille.Range("B14", "B20").Select
feuille.Range("B14", "B20").Copy
Windows("Controle.xlsm").Activate
Range("H3", "H9").Activate
Range("H3", "H9").Select
ActiveSheet.Paste
appxl.Workbooks(strFichier).Close SaveChanges:=False
For i = 2 To 7
Sheets("Feuil1").Columns(i).Rows(Lig) = Sheets("Feuil1").Columns("H").Rows(i + 1)
Next i
Range("H3", "H9").Clear
End If
Wend |
Partager