オートフィルタ／可視セル／右隣りシート／文末に貼り付け
現在のアクティブシートの特定の列（列A）にフィルターをかけ、そのフィルターで表示される行を別のシートにコピーして転記し、元のシートから削除する方法
Sub オートフィルタ_可視セル_別シート_右隣り_文末転記()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.ActiveSheet
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
LastCol1 = ws1.Cells(2, Columns.Count).End(xlToLeft).Column
Dim MyCell As Range
Set MyCell = ws1.Range("A1", Cells(LastRow1, LastCol1))
'オートフィルタ
MyCell.Select
MyCell.AutoFilter 1, "*埼玉*"
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.ActiveSheet.Next
Dim LastRow2 As Long
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
MyCell.SpecialCells(xlCellTypeVisible).Copy _
Destination:=rng
rng.EntireRow.Delete Shift:=xlUp
Application.CutCopyMode = False
ws1.AutoFilterMode = False
ws1.Range("A1").Select
ActiveWorkbook.Save
MsgBox "完了" & vbLf & "基=" & LastRow1 & vbLf & "先=" & LastRow2 & vbLf & "Copy後=" & LastRow1 + LastRow2
End Sub解説
- ws1には、現在アクティブなシートが代入されます。
- LastRow1には、列Aで最終行の行番号が代入され、LastCol1には最後の列の列番号が代入されます。
- MyCellには、シートws1内のA1セルから最後の行・列までを含む範囲が代入されます。
- MyCellの1列目をフィルターし、「埼玉」を含む行のみを表示します。
- ws2には、現在アクティブなシートの次のシートが代入されます。
- LastRow2には、ws2内で最後の行の行番号が代入され、rngには、ws2内で次に書き込むべきセルが代入されます。
- フィルターされた行をコピーして、rngに貼り付けます。
- MyCellのフィルターで表示された行をws2に転記した後、元のシートからその行を削除します。
- フィルターをクリアします。
- 現在のブックを保存します。
- 完了メッセージを表示します。基は元のシートの最終行、先は転記先シートの最終行、Copy後は元のシートと転記先シートの行数の合計です。
コメント