【Excelマクロ】表を1行ずつ抜粋してシートを分割するマクロ

　こんにちは、masaです。

　今日は自分用のメモとして「表を1行ずつ抜粋してシートを分割するマクロ」についてまとめておこうと思います。

　10行くらいは手動でやる方が早いですが、100行とか、1000行とかを分割する場合はコードにしてしまった方が早いですし（正確なので）、コードにしてみました。ぶっちゃけあまり需要がなさそうなんですけどね…汗

 ▽以下の図がコードの主旨・意図です。

 コードの意味・主旨：仮に以下のような表があったとします。

　1行目は据え置きとし、それぞれNo.ごと1～10まで別個の表としたい場合を想定しています。

▽例：No.1

▽例：No.10

完成したコードはこちらです。

 　とりあえず、全部のコードを貼っておきます。後で書きますが、1行目とそれ以外で処理方法が異なります。

Sub 削除()

Dim i As Integer
Dim j As Integer
Dim k As Integer

For i = 1 To 10 '最後の行数を入力
'元シートをコピーし、元シートの左側に貼付け
ActiveSheet.Copy before:=Worksheets(Worksheets.Count)

'削除処理①
'i+2行以降の全ての行を削除する
For j = 1 To 10 '最後の行数を入力
Rows(i + 2).Delete
Next j

'削除処理②
'i=1よりも大きいときは先頭付近の行を削除する
If i > 1 Then
For k = 2 To i
Rows(2).Delete
Next k

End If

'元のシートを選択する。
ActiveSheet.Next.Activate

Next i

End Sub

元のシートをコピーして、元シートの左側に貼付け

　これをしておくことで元のシートはそのままの状態とし、元のシートからコピペしたシートの行を削除する処理をします。

'元シートをコピーし、元シートの左側に貼付け
ActiveSheet.Copy before:=Worksheets(Worksheets.Count)

削除処理①：残したい行よりも後の行を削除

　行の削除は範囲指定をして削除することができないみたいで、1行ずつを任意の数だけ削除するコードとしました。

'削除処理①
'i+2行以降の全ての行を削除する
For j = 1 To 10 '最後の行数を入力
Rows(i + 2).Delete
Next j

削除処理②：残したい行よりも前の行を削除（iが2以上に適用）

　削除の始点がiとしていて、徐々に増えていく特性のため、iが2以上のときは上部に削除すべき行が発生するのでそれに対応するコードとなっています。

'削除処理②
'i=1よりも大きいときは先頭付近の行を削除する
If i > 1 Then
For k = 2 To i
Rows(2).Delete
Next k

End If

元のシートを選択する。

 元のシートの左側にシートをコピーして作業しているため削除処理が完了したときに、元のシートに戻るように右側のシートを選択するコードとなっています。

'元のシートを選択する。
ActiveSheet.Next.Activate

CASE1：i=1のときの考え方

CASE2：i=1ではないときの考え方

おわりに

　自動化している作業がマニアック過ぎてこのコード全体が役に立つとは思えませんが、現在のシートから見て左のシートを選択するコードや右のシートを選択するコード、行の削除のコード、複数の変数の使い方という部分で役に立つのかなと思っています。