anthooooony
XLDnaute Occasionnel
Bonjour,
Je vous écris car j'ai un code VBA qui est de plus en plus long en traitement. En faite, tous les jours des fichiers se mettent dans un dossier, ensuite grâce au code ci dessous je les récupère tous j'en reçois 14 par jour j'en ai deja plus de 200 en 15 jours ça promet 😀
Chose faite :
Pour améliorer j'ai rajouté application.screenUpdating vu sur exceldownload mais ca n'accélère pas trop la rapidité de cette macro
Auriez vous d'autres bout de code tel que le screenUpldating permettant d'améliorer la macro?
Aussi, comment serait -il possible d'intégrer un contrôle de doublons, en faite ce code efface tout et reprend tous les fichiers et ça tous les jours. je pense que de ne prendre que les fichiers récents améliorerait la rapidité de l'exécution...
En vous remerciant par avance de votre aide.
Anthooooony
Je vous écris car j'ai un code VBA qui est de plus en plus long en traitement. En faite, tous les jours des fichiers se mettent dans un dossier, ensuite grâce au code ci dessous je les récupère tous j'en reçois 14 par jour j'en ai deja plus de 200 en 15 jours ça promet 😀
Chose faite :
Pour améliorer j'ai rajouté application.screenUpdating vu sur exceldownload mais ca n'accélère pas trop la rapidité de cette macro
Auriez vous d'autres bout de code tel que le screenUpldating permettant d'améliorer la macro?
Aussi, comment serait -il possible d'intégrer un contrôle de doublons, en faite ce code efface tout et reprend tous les fichiers et ça tous les jours. je pense que de ne prendre que les fichiers récents améliorerait la rapidité de l'exécution...
Code:
Sub aaaaa()
Application.ScreenUpdating = False
sousRépertoire = "Fichiers Retard Relance"
[A2].CurrentRegion.Offset(1, 0).Clear
Set maitre = ActiveWorkbook
Repertoire = ThisWorkbook.Path
nf = Dir(Repertoire & "\" & sousRépertoire & "\*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=Repertoire & "\" & sousRépertoire & "\" & nf
With ThisWorkbook.Sheets("Feuil1")
derlig = .Range("A65000").End(xlUp).Row + 1
.Range("A" & derlig) = DateSerial((Mid(Cells(1, 1), 18, 4)), (Mid(Cells(1, 1), 15, 2)), (Mid(Cells(1, 1), 12, 2)))
.Range("B" & derlig) = Left([D7], InStr(1, [D7], " ") - 1)
.Range("C" & derlig) = LTrim(Split([B3] & " ")(0))
.Range("D" & derlig) = Application.Sum(Range("j1").EntireColumn) / 2
End With
ActiveWorkbook.Close False
nf = Dir ' fichier suivant
ActiveWorkbook.RefreshAll
Loop
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End SubEn vous remerciant par avance de votre aide.
Anthooooony