エクセルで集計表を作成するマクロで悩んでいます。
エクセルで集計表を作成するマクロで悩んでいます。
日付ごとにシート別に分かれたデータを「集計表」として新しいシートに集めたいと思っています。
●元データに関して
1行目は空欄
2行目は表の名前
3行目は日付
4～7行目は番号・数量などの項目
8行目から多い場合で50行目くらいまで番号ごとの情報が並んでいます。
AC列まで並んでいます。・・・・・・●画像左上が元データ
●このファイルから、(1)集計表という新しいシートを作成して(2)そのファイルに日付ごとの
データが下方向に集まるように集計したいと思っています。
そこで、次のＶＢＡを作成しました。
Sub 集計表()
Dim ws As Worksheet
For Each ws In Worksheets
’AD列にシート名を入れる
ws.Range("AD1:AD100").Value = ws.Name
Next ws
Dim newSh As String
Dim Sh As Worksheet, myFlag As Boolean
newSh = "集計表"
myFlag = False
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name = newSh Then
myFlag = True
'----全データシートのデータをクリアし、先頭へ移動します
Worksheets(newSh).Cells.ClearContents
Worksheets(newSh).Move before:=Sheets(1)
Exit For
End If
Next Sh
'----全データシートを先頭へ追加します
If myFlag = False Then
ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
End If
Worksheets(2).Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
ActiveSheet.Paste
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----列見出しをコピーします
Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
For i = 2 To Worksheets.Count
With Worksheets(i)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
'----シートのデータが8行以上の場合にコピーします
If lRow >= 8 Then
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1)
End If
End With
Next i
Worksheets(1).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub
この方法だと、「番号」などを含むシートごとの全ての情報がコピーされてしまいます。
●左下画像
これを「(1)１枚目のシートの１行目から７行目(2)１枚目シートの８行目からＡ列に1以上の番号が
入っている行(3)２枚目シートの８行目からＡ列に1以上の番号が入っている行(4)３枚目シートの・・・」というように全てのシートに対して集計することはできないでしょうか。
●右下画像
ＶＢＡを始めたばかりなので、まだ、あまり理解できていません。
お礼
いったん保存をしていませんでした。いったん保存で、出来ました。しかし、なぜこうなるのかがわかりません。
補足
早速の回答ありがとうございます。早速やってみましたが 全然ダメでした。