Как я могу сделать мой код быстрее?(Копирование столбцов)

Question

Я новичок в vba и написал код ниже, чтобы сопоставлять и копировать столбцы;Я пытаюсь выяснить, как сделать его более эффективным, поскольку требуется некоторое время, чтобы произвести вывод.Любые советы или отзывы будут высоко оценены!Я думал о переключении обновления экрана на false, но это не ускоряет процесс.Может ли это быть медленным, потому что я использую метод автофильтрации ячеек?Заранее спасибо.

Sub GetItems()
    Dim cel As Range
    Dim celAddress As Range
    Dim n As Integer
    Dim SelRange As Range
    Dim BrandsPasteLoc As Range

    n = 1

    'Application.ScreenUpdating = False

    Worksheets("CA").Activate
    ActiveSheet.Range("$A$1:$L$2622").AutoFilter Field:=10, Criteria1:="<>#N/A", 
    Criteria2:="<>0", Operator:=xlFilterValues

    Worksheets("Items to push to CA").Activate

    For Each cel In Range("A1:O1")
        Brand = cel.Value
        If Brand = "" Then
            Resume Next
        End If
        Worksheets("CA").Activate
        Application.Workbooks("Items Suggestion_CA").Worksheets("MY").Range("$A$1:$M$3959").AutoFilter Field:=5, Criteria1:=Brand, Operator:=xlFilterValues


        Range("B:B").Sort _
           Key1:=Range("b1"), Order1:=xlDescending     'sorts on Quantity

        Columns("A:A").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("Items to push to CA").Select
        Set SelRange = ActiveSheet.Columns(n)
        Set BrandsPasteLoc = Range(Range("A1:Z1").Find(Brand).Offset(1), Range("A1:Z1").Find(Brand).Offset(1).End(xlDown))
        BrandsPasteLoc.Select
        ActiveSheet.Paste
        Worksheets(“CA”).Activate
        n = n + 1
    Next cel

    Worksheets("Items to push to CA").Rows(2).Delete

    Worksheets("Items to push to CA").Activate
    Columns("A:O").Select
    Selection.EntireColumn.AutoFit
    Worksheets("Items to push to CA").Rows(60 & ":" & 
    Sheet1.Rows.Count).ClearContents

    Worksheets("CA").Activate
    Cells.AutoFilter

    Worksheets("Items to push to CA").Activate

    'Application.ScreenUpdating = True
End Sub

Answer 1

Этот вопрос больше для Проверка кода , но попробуйте добавить Application.ScreenUpdating=False, когда подпрограмма начинается, и Application.ScreenUpdating=True, когда подпрограмма заканчивается

.