Как оптимизировать время выполнения этого кода

Question

У меня есть этот отчет в моей компании, и время записи данных в таблицы занимает слишком много времени.

Я пытался не использовать переменную "main" в именах листов или таблиц, но время то же самое.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

main = Range("Line").Value

Set ws = Sheets("Database " & main)
Set wh = Sheets("Downtimes " & main)
Set wl = Sheets("Losses " & main)
Set wa = Sheets("PlannedStops " & main)

Set ts = ws.ListObjects("Database_" & main)
Set th = wh.ListObjects("Downtimes_" & main)
Set tl = wl.ListObjects("Losses_" & main)
Set ta = wa.ListObjects("PlannedStops_" & main)

ws.Visible = True
wh.Visible = True
wl.Visible = True
wa.Visible = True

If ts.ShowAutoFilter Then

    ts.AutoFilter.ShowAllData

End If

'======================================================================================

If (wp.Range("PLOT")) = 0 Then

    With wa

        For i = 1 To wp.ListObjects("PLST").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PLST").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = ta.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PLST").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PLST").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

Else

    With ws
        Set newrow = ts.ListRows.Add
        With newrow
            .Range(1).Value = wp.Range("Date")
            .Range(5).Value = wp.Range("Shift")
            .Range(6).Value = wp.Range("ShiftLeader")
            .Range(7).Value = wp.Range("Color")
            .Range(8).Value = wp.Range("PLOT")
            .Range(9).Value = wp.Range("OPT")
            .Range(10).Value = wp.Range("PRDT")
            .Range(11).Value = wp.Range("PFMT")
            .Range(12).Value = wp.Range("EFT")
            .Range(13).Value = wp.Range("PLTM")
        End With
        Set newrow = Nothing
    End With

    With wh

        For i = 1 To wp.ListObjects("DWNT").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("DWNT").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = th.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("DWNT").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("DWNT").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

    With wl

        For i = 1 To wp.ListObjects("PFLS").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PFLS").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = tl.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PFLS").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PFLS").DataBodyRange(i, 4).Value
                    .Range(10).Value = wp.ListObjects("PFLS").DataBodyRange(i, 3).Value
                End With
                Set newrow = Nothing
            End If

        Next i

        If wp.Range("UNLS") = 0 Then
        Else
            Set newrow = tl.ListRows.Add
            With newrow
                .Range(1).Value = wp.Range("Date")
                .Range(5).Value = wp.Range("Shift")
                .Range(6).Value = wp.Range("ShiftLeader")
                .Range(7).Value = wp.Range("Color")
                .Range(8).Value = "Null"
                .Range(9).Value = wp.Range("UNLS")
                .Range(10).Value = "Pérdidas no identificadas"
            End With
            Set newrow = Nothing
        End If

    End With

    With wa

        For i = 1 To wp.ListObjects("PLST").DataBodyRange.Rows.Count

            If IsEmpty(wp.ListObjects("PLST").DataBodyRange(i, 1)) Then
                Exit For
            Else
                Set newrow = ta.ListRows.Add
                With newrow
                    .Range(1).Value = wp.Range("Date")
                    .Range(5).Value = wp.Range("Shift")
                    .Range(6).Value = wp.Range("ShiftLeader")
                    .Range(7).Value = wp.Range("Color")
                    .Range(8).Value = wp.ListObjects("PLST").DataBodyRange(i, 1).Value
                    .Range(9).Value = wp.ListObjects("PLST").DataBodyRange(i, 2).Value
                End With
                Set newrow = Nothing
            End If

        Next i

    End With

End If

ws.Visible = False
wh.Visible = False
wl.Visible = False
wa.Visible = False

Application.ScreenUpdating = True

End Sub

У меня нет ошибок, мой код работает нормально, там больше кода на том же листе, но я подумал, что эта часть была самой трудоемкой в ​​коде, есть ли какой-нибудь способ предложить его для ускорения