Code trop lent pour le transfert de données d'un onglet à un autre

Le 18/08/2022 à 16:34

Bonjour,

J'aimerais savoir s'il y a une façon de rendre plus rapide l'exécution de code suivant en le modifiant.

    Sheets(Onglet).Activate
    Sheets(Onglet).Range("C3").Select
    Do Until ActiveCell.Offset(0, 0) = "Fin"
        Selection.End(xlDown).Select
        If Sheets(Onglet).Range("P" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 17 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 17 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 17 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("AL" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 39 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 39 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 39 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("BH" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 61 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 61 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 61 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("CD" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 83 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 83 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 83 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("CZ" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 105 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 105 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 105 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("DV" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 127 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 127 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 127 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
    Loop

J'ai au début et à la fin de mon code ceci :

Sub Demarre_Calcul()
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sub Arret_Calcul()
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
End Sub

Merci

Le 18/08/2022 à 16:54

Bonjour sauf erreur de ma part, il me parait bizarre d'avoir séparer ton optimisation en 2 sub, elle ne serait pas mieux comme cela ?

Sub Demarre_Calcul()

EnableEvents = True
Calculation = xlCalculationManual
ScreenUpdating = True

Sheets(Onglet).Activate
    Sheets(Onglet).Range("C3").Select
    Do Until ActiveCell.Offset(0, 0) = "Fin"
        Selection.End(xlDown).Select
        If Sheets(Onglet).Range("P" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 17 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 17 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 17 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("AL" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 39 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 39 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 39 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("BH" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 61 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 61 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 61 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("CD" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 83 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 83 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 83 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("CZ" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 105 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 105 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 105 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
        If Sheets(Onglet).Range("DV" & ActiveCell.Row) <> 0 Then
            For i = 1 To 12
                If Sheets(Onglet).Cells(ActiveCell.Row, 127 + i) <> 0 Then
                    DonneesBudget.Range("A" & dligRes).Value = Sheets(Onglet).Range("D4").Value
                    DonneesBudget.Range("C" & dligRes).Value = Sheets(Onglet).Range("C" & ActiveCell.Row).Value
                    DonneesBudget.Range("D" & dligRes).Value = Sheets(Onglet).Range("D" & ActiveCell.Row).Value
                    DonneesBudget.Range("B" & dligRes).Value = Sheets(Onglet).Cells(5, 127 + i).Value
                    DonneesBudget.Range("E" & dligRes).Value = Sheets(Onglet).Cells(ActiveCell.Row, 127 + i).Value
                    dligRes = dligRes + 1
                End If
            Next i
        End If
    Loop

EnableEvents = False
Calculation = xlCalculationAutomatic
        .ScreenUpdating = False
End Sub

De plus, il faut que tu arrives à retirer tous les "Selects"

Le 18/08/2022 à 17:21

Bonjour et merci pour la réponse,

Je vous ai expédié seulement la partie qui est lente et la section plus haut fait un call à Arret_Calcul et à la fin il y a Redemarre_Calcul.

Merci

Rechercher des sujets similaires à "code trop lent transfert donnees onglet"