オフセットを使用して次の可視セルに移動します。

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

範囲コピー、カット、および削除では、フィルタリングされた範囲の表示セルだけが自動的に選択されます。

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