Перейти к следующей видимой ячейке с использованием смещения

Question

У меня есть автофильтрованная таблица в excel. Я должен скопировать значения вставки на основе определенных условий, и я должен выполнить это во всех видимых ячейках в определенном столбце. Я написал код, и он работает хорошо, но единственное, что это занимает много времени, так как существует много строк. Может кто-нибудь, пожалуйста, помогите мне, как потребовать время? Вот код. Благодаря!

Sub TrialAnotherOne() 


Windows("Epson Itemcodes.xlsm").Activate 
    Range("A" & i).Select 
    Selection.Copy 

Windows("Epson ASINs.xlsx").Activate 
    Range("U1048576").End(xlUp).Offset(0, -12).Select 


If ActiveCell.Value <> "Itemcode" Then 

If ActiveCell.Value = "" Then 
    ActiveSheet.Paste 

    Else 

    If ActiveCell.Value = Workbooks("Epson Itemcodes.xlsm").Sheets("Sheet1").Range("A" & i).Value Then 
    ActiveSheet.Paste 

    Else 
    ActiveCell.Value = "Conflct" 

    End If 
    End If 

Else 
Windows("Epson Itemcodes.xlsm").Activate 
Range("I" & i).Value = "No match found" 

End If 

If ActiveCell.Value <> "Itemcode" Then 


With ActiveSheet 
Do 

ActiveCell.Offset(-1, 0).Activate 
Do While ActiveCell.EntireRow.Hidden = True 
ActiveCell.Offset(-1, 0).Activate 
Loop 

If ActiveCell.Value <> "Itemcode" Then 

If ActiveCell.Value = "" Then 
    ActiveSheet.Paste 

    Else 

    If ActiveCell.Value = Workbooks("Epson Itemcodes.xlsm").Sheets("Sheet1").Range("A" & i).Value Then 
    ActiveSheet.Paste 

    Else 

    ActiveCell.Value = "Conflct" 

    End If 
    End If 

Else 
Exit Do 

End If 

Loop 
End With 

End If 

End Sub 

Answer 1

Range Copy, Cut и Delete автоматически выбирает только видимые ячейки отфильтрованного диапазона.

Sub CopyFilteredColumn() 
    Dim Target As Range 

    'Size the Target range to fit the table 
    'Define the starting row "C1:J19" 
    'Extend the Target range to the last row .Range("C" & .Rows.Count).End(xlUp) 
    'Column C is used because it will never have blank cells 
    With Worksheets("Source Sheet") 
     Set Target = .Range("C1:J19", .Range("C" & .Rows.Count).End(xlUp)) 
    End With 

    Target.AutoFilter Field:=1, Criteria1:=">40", Operator:=xlAnd 

    'Header and data 
    'Copy the visible cells of the 3rd column of the table 
    Target.Columns(3).Copy Worksheets("Target Sheet").Range("A1") 
    'Data only - Includes 1 blank cell at the end 
    Target.Offset(1).Columns(3).Copy Worksheets("Target Sheet").Range("C1") 

End Sub