Optimisation de macro : fichiers trop volumineux

Bonjour,

J'utilise la macro suivante pour parcourir tous les dossiers d'un répertoire (plusieurs centaines), et ouvrir un fichier données.csv dans chacun d'entre eux pour en extraire la valeur de la cellule A2 ainsi que la dernière valeur de la colonne A. La longueur de ces fichiers est variable et ils sont très volumineux.

La macro a accompli la tâche en 55 minutes pour 224 fichiers. Mais étonnamment, elle s'est régulièrement trompée en me remplaçant la dernière valeur de la colonne A (qui devrait être une valeur Unix timestamp) par la valeur de la cellule A1 (qui reprend le titre de la colonne). Auriez-vous de quelconques indications sur pourquoi cela se passe ? Et aussi, des idées sur comment je pourrais optimiser cette macro pour que la tâche soit plus rapide ?

Merci infiniment,

CL

Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

Dim Wb As Workbook
Dim strFile As String
Dim strDir As String
Dim StartTime As Double
Dim SecondsElapsed As Double

Dim fdest As Worksheet, fsource As Worksheet
Dim dlig As Long
Dim sval As String

StartTime = Timer

cpath = ThisWorkbook.Path & "\"
Set fdest = ActiveSheet

dlig = 2

Application.ScreenUpdating = False
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\Macro_test\")
i = 1
'loops through each folder in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name

    strDir = objSubFolder.Path
    strFile = strDir & "\données.csv"
    'Loop
    
    Do While strFile <> ""
    Set Wb = Workbooks.Open(strFile)
    Set fsource = Wb.Sheets(1)
        sval = fsource.Cells(Rows.Count, 1).End(xlUp)
        fdest.Cells(dlig, 9) = fsource.Cells(2, 1)
        fdest.Cells(dlig, 10) = sval
        Wb.Close
        dlig = dlig + 1
        Exit Do
    Loop

    i = i + 1
    
Next objSubFolder

Application.ScreenUpdating = True

SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation


End Sub