【Excelマクロ】同じ形式のシートから指定したセルのコピペをひたすら繰返すマクロ

　こんにちは、masaです。

　仕事であるシートのセル番地:A6をコピーして、一番右のシートのB行に上から順番にコピペする的なダルい作業の自動化に成功したのでメモ書き程度に書いていきます。

　全体のコードも丸っと転用できますし、所々切り取っても今後役に立ちそうなパーツがあるのでそれについてもメモしておきます。

作ったマクロのコード

Sub コピペ()

Dim i As Integer
Dim maxrow1 As Integer
Dim a As Integer

Range("D2") = "データA"

ActiveSheet.Name = "データまとめ"

'シートの数だけコピペを繰返す
For i = 1 To (Worksheets.Count - 1)

Sheets(i).Select

'①データコピー
'P11をコピーしたいセルに変更
Range("P11").Select
Selection.Copy

'②データ貼付け
'一番右のシートを選択
Worksheets(Worksheets.Count).Select
'↓D列(4)に入力されている一番下のセルを特定
maxrow1 = Cells(Rows.Count, 4).End(xlUp).Row
'入力されている一番下の次のセルに貼り付ける
Cells(maxrow1 + 1, 4).PasteSpecial xlPasteValues

'③シート名をコピーして、データの左に貼付け
Sheets(i).Select
a = ActiveSheet.Name
Worksheets(Worksheets.Count).Select
Cells(maxrow1 + 1, 3) = a

End Sub

　コードの中身としては、

1. シートの数(-1)だけコピペを繰り返す設定をしておく
2. 一番左のシートから順番に選択していって、特定のセルを選んでコピー
3. 一番右のシートを選んで貼り付け(数値のみの貼り付け)
4. 貼り付ける際には上から順番に貼るために入力済みの一番上のセルを特定
5. そのセルの左隣に貼り付け元のシート名を貼り付け
6. 2.に戻る、を「シートの数-1」回繰り返す

　といった感じです。

汎用性がありそうなコードの解説

①シートの数を数える

For i = 1 To (Worksheets.Count - 1)

'Worksheets.Countで、シートの数を数える。

②左からn番目のシートを選択する。

 Sheets(i).Select

 ③一番右のシートを選択する。

Worksheets(Worksheets.Count).Select
'一番右のシート=シートの数=Worksheets.Count

 ④特定の列の一番下に入力されているセルを特定する。

'D列(4)に入力されている一番下のセルを特定
maxrow1 = Cells(Rows.Count, 4).End(xlUp).Row

 ⑤選択中のシート名を取得する。

a = ActiveSheet.Name