エクセル、複数のシートのデータをマクロでコピーを行い別シートに貼り付けまとめる方法

シートが27シートあります。シートごとにデータが入っているものをコピーを行い一つのシートにまとめたいと思っております。

Sheet1～Sheet27までそれぞれ名前を変更しております。
１つのシートには、１個目のデータ１行目が、Ａ列の7行目からＨ列７行目まであります。
7行目から下にデータが入っております。
シートの中には、データが入っていないものもございます。

シートのデータを一つのシートにまとめたいと思っております。

素人で申し訳ございません。
お教え下さい。

No.1 ベストアンサー 回答者： soixante 回答日時： 2015/12/05 17:17

＞１つのシートには、１個目のデータ１行目が、Ａ列の7行目からＨ列７行目まであります。

ここの意味が良く分かりませんが、各シートの1行目から7行目までがヘッダーとなっており、
8行目以降に、A～H列までデータがあると理解して書きます。
シートは1枚目から27枚目まで。

'--------------------------------------------------------
Option Explicit

Sub DATA_MATOME()
Dim k As Integer, LstRow As Long, TgtRow As Long
Dim WsM As Worksheet, Rng As Range

Application.ScreenUpdating = False

'まとめシートを作成し、ヘッダーを作成
Set WsM = Worksheets.Add(before:=Worksheets(1))
ActiveSheet.Name = "まとめ"
With Worksheets(2)
　Set Rng = .Range(.Cells(1, 1), .Cells(7, 8))
End With
Rng.Copy WsM.Cells(1, 1)

'１～27枚目をループ
For k = 2 To 28
　Worksheets(k).Select
　LstRow = Cells(Rows.Count, 1).End(xlUp).Row

　If LstRow > 7 Then 'データがあるならそのデータをコピーしてまとめシートへ
　　Set Rng = Range(Cells(8, 1), Cells(LstRow, 8))
　　TgtRow = WsM.Cells(Rows.Count, 1).End(xlUp).Row + 1 'まとめシートの貼付行
　　Rng.Copy WsM.Cells(TgtRow, 1)
　Else
　End If
Next k

WsM.Select

Set Rng = Nothing
Set WsM = Nothing
Application.ScreenUpdating = True

MsgBox "End."

End Sub
'--------------------------------------------------------

この回答へのお礼

ありがとうございました。無事できました。

お礼日時：2015/12/05 18:06