Accélération du traitement de ma macro
Bonsoir à tous,
voici une petite macro qui fonctionne bien mais avec un temps de réalisation important.
Cela est-il dû au nombres de lignes à reporter environ 150 dans la partie "Recopie des données traitées dans Bull Macro"?
Ou bien il s'agit d'une contrainte réseau pour la copie " 'Enregistrement d'une copie dans répertoire logistique"?
Existe-t-il un moyen de l'accélérer?
Merci d'avance pour vos réponses et bonne soirée
Ma petite macro:
Sub COPIEDESDONNEESTRAITEES_JV()
'
' Recopie des données traitées dans Bull Macro
'
Application.ScreenUpdating = False
With Sheets("Jeudi_Vendredi")
Set plage = .Range("A9:A" & .Range("A65000").End(xlUp).Row)
For Each c In plage
If c.Value <> "" Then
x = Sheets("Bull").Range("A65000").End(xlUp).Row + 1
c.EntireRow.Copy Sheets("Bull").Rows(x)
End If
Next c
End With
'mise en forme des cellules de la feuille Bull
Sheets("Bull").Select
Range("A1048575:M1048576").Select
Selection.Copy
Range("A9:M1050").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'sauvegarde du fichier
ActiveWorkbook.Save
'Enregistrement d'une copie dans repertoire logistique
Dim Chemin As String, Fichier As String
Chemin = "G:\INTER\Controle qualite_Logistique\bulletins traités\"
Fichier = ThisWorkbook.Name
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End Sub
bonsoir,
à tester ...
Sub COPIEDESDONNEESTRAITEES_JV()
'
' Recopie des données traitées dans Bull Macro
'
Application.ScreenUpdating = False
With Sheets("Jeudi_Vendredi")
Set plage = .Range("A9:A" & .Range("A65000").End(xlUp).Row + 1)
x = Sheets("Bull").Range("A65000").End(xlUp).Row
' copie par bloc de lignes plutôt que lignes par ligne pour diminuer le temps d'exécution.
For Each c In plage
If c.Value <> "" Then
If fr = 0 Then fr = c.Row
Else
If fr <> 0 Then
x = x + 1
.Rows(fr & ":" & c.Row - 1).Copy Sheets("Bull").Rows(x)
x = x + c.Row - 1 - fr
fr = 0
End If
End If
Next c
End With
'mise en forme des cellules de la feuille Bull
Sheets("Bull").Range("A1048575:M1048576").Copy
Sheets("Bull").Range("A9:M1050").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'sauvegarde du fichier
ActiveWorkbook.Save
'Enregistrement d'une copie dans repertoire logistique
Dim Chemin As String, Fichier As String
Chemin = "G:\INTER\Controle qualite_Logistique\bulletins traités\"
Fichier = ThisWorkbook.Name
ActiveWorkbook.SaveCopyAs Chemin & Fichier
Application.ScreenUpdating = True
End Sub
Bonjour h2so4,
je vous confirme que votre solution était la bonne pour accélérer ce process de recopie. Un grand merci.
Bonne journée