|
最終行は下記のようにして求めることができます。
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
フィルタで抽出した段階で、
2行目からlastRowを対象にして貼付けると
可視セルだけに貼り付けることができます。
後半部分は、下記のコードを参考にしてください。
一行空白行がありますから、そこに注目して、Areasを活用します。
Sub test()
Dim lastRow As Long
Dim area As Range
Dim myRng As Range
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set myRng = Range("A1", Cells(lastRow, 1)).SpecialCells(xlCellTypeConstants)
For Each area In myRng.Areas
Set r = area.Resize(, 4)
Debug.Print r.Address '確認用
' r を 新しいブックのシートにコピー。
' シート名は r(1).Valueに変更
Next
End Sub
|
|