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

Rechercher des sujets similaires à "acceleration traitement macro"