Как ускорить мой VBA сбор данных с рабочих листов

Question

У меня есть макрос, собирающий данные из разных листов.Я скопирую свой код ниже.Это кажется медленным, и это, вероятно, из-за моего отсутствия навыков в VBA

Есть ли какая-то помощь, чтобы получить от сообщества, чтобы ускорить процесс.Теперь кажется, что время ожидания для моих пользователей этой рабочей книги очень велико

Sub Rectangle2_Click()

Range("f5:bh42").Clear

On Error Resume Next
Range("5:200").EntireRow.Hidden = False

Range("g:bh").EntireColumn.Hidden = False

Application.ScreenUpdating = False

Sheet1.Range("g169:bh169").COPY
With ActiveSheet.Range("g5")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet1.Range("e1").COPY
With ActiveSheet.Range("f5")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet3.Range("g169:bh169").COPY
With ActiveSheet.Range("g6")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet3.Range("e1").COPY
With ActiveSheet.Range("f6")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet5.Range("g169:bh169").COPY
With ActiveSheet.Range("g7")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet5.Range("e1").COPY
With ActiveSheet.Range("f7")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet9.Range("g169:bh169").COPY
With ActiveSheet.Range("g8")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet9.Range("e1").COPY
With ActiveSheet.Range("f8")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet10.Range("g169:bh169").COPY
With ActiveSheet.Range("g9")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet10.Range("e1").COPY
With ActiveSheet.Range("f9")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet11.Range("g169:bh169").COPY
With ActiveSheet.Range("g10")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet11.Range("e1").COPY
With ActiveSheet.Range("f10")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet12.Range("g169:bh169").COPY
With ActiveSheet.Range("g11")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet12.Range("e1").COPY
With ActiveSheet.Range("f11")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet13.Range("g169:bh169").COPY
With ActiveSheet.Range("g12")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet13.Range("e1").COPY
With ActiveSheet.Range("f12")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

И еще 10 случаев копирования

Sheet28.Range("g169:bh169").COPY
With ActiveSheet.Range("g27")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Sheet28.Range("e1").COPY
With ActiveSheet.Range("f27")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

For Each c In Range("BI5:BI42").Cells
    If c.Value = "0" Then
        c.EntireRow.Hidden = True
    Else
        c.EntireRow.Hidden = False
    End If
Next

Dim u As Range

    For Each u In Range("g43:bh43").Cells
        If u.Value = "0" Then
        u.EntireColumn.Hidden = True

    End If
Next u

Application.ScreenUpdating = True

End Sub

Спасибо, Мартин