使用偏移量转到下一个可见单元格

我有一个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

范围复制，剪切和删除自动只select过滤范围的可见单元格。

 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