Optimisation de macro

Bonjour à tous,

je viens vers vous car mon code qui fonctionne très bien (merci 3GB), le seul hic est que la macro met un peu de temps à se terminer.

Pour le moment elle vient vérifier 3 fichiers mais je peux en avoir 80.

Voici le code, le but est le suivant:

J'ai un répertoire contenant 80 fichiers + 1 de synthèse

Chacun des 80 fichiers contient 1 onglet à copier dans mon fichier de synthèse.

Si l'onglet existe déjà dans mon fichier de synthèse il est effacé puis remplacé par l'onglet du fichier source correspondant, comme ça je suis sur d'avoir la dernière version de l'onglet dans mon fichier de synthèse

Sub FusionFichiers()

Dim wbdest As Workbook, wb As Workbook
Dim ws As Worksheet
Dim nomwb$, nomws$

Application.ScreenUpdating = False
'Application.Visible = False

chemin = ThisWorkbook.Path & "\"
Set wbdest = ThisWorkbook

nomwb = Dir(chemin & "*20*.xlsm") ' Premier fichier
Do While nomwb <> ""
Set wb = Workbooks.Open(chemin & nomwb)
For Each ws In wb.Worksheets
If ws.Name <> "Personnels" Then 'ou ws.Visible = True Then
nomws = ws.Name
If FeuilleExiste(wbdest, nomws) Then
ws.Cells.Copy Destination:=wbdest.Sheets(nomws).Cells
Else
ws.Copy after:=wbdest.Sheets(wbdest.Sheets.Count)
Range("A2").Select
End If
Exit For
End If
Next ws
wb.Close True
nomwb = Dir ' Fichier suivant
Loop

'Application.Visible = True
Application.ScreenUpdating = True

End Sub

Function FeuilleExiste(Classeur As Workbook, NomFeuille$) As Boolean
On Error Resume Next
FeuilleExiste = Classeur.Sheets(NomFeuille).Index
End Function

Sub Tri_onglets()
Application.ScreenUpdating = False
Dim iSheets%, i%, j%
iSheets = Sheets.Count

For i = 1 To iSheets - 1
For j = i + 1 To iSheets
If Sheets(j).Name < Sheets(i).Name Then
Sheets(j).Move Before:=Sheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
Sheets("Preparation").Move Before:=Sheets(1)
Sheets("Preparation").Activate
MsgBox ("LA FUSION DES FICHIERS EST TERMINEE AVEC SUCCES!")
End Sub

Bonjour,

Tu serais bien aimable d'utiliser le bouton  </>  afin de baliser ton code > les forumeurs apprécieront ...
Tu serais bien aimable aussi d'indenter ton code > les forumeurs apprécieront cela aussi ...

Pas hasard > les feuilles importées contiennent-elles des formules ?

Si oui > tester avec  Application.Calculation = xlCalculationManual  au début ....

Ne pas oublier  Application.Calculation = xlCalculationAutomatic  à la fin ...

ric

Salut, tu peux ajouter ces lignes au début et à la fin du code:

Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Quand tu dit que ton programme est long, c'est combien de temps environ ?

Parce que l'ouverture et la fermeture du classeur c'est toujours long, et ca dépend bcp de ton ordinateur j'ai déja eu ce problème sur un code je n'ai jamais pu l'optimiser.. à tel point que j'avais fait une barre de progression dans un Userform pour faire patienter l'utilisateur

Curieux de savoir si certaines personnes apportent de meilleurs solutions ici vu que j'ai le même prob

La macro tourne pendant 7 secondes environ pour ces 3 fichiers

L'ajout de ton code gabin37 n'apporte pas de gain de temps, merci quand même pour ton aide

Ric tu as raison j'y ferai attention Mea culpa

Rechercher des sujets similaires à "optimisation macro"