| シートのチェックは必要なさそうなので、コメントアウトしています。
'sh_check
まとめるシートはシート見出しの2番目のシートにしています。
3番目のシートのB6:J6がデータの列見出しなので、コピーして2番目のシートに貼り付け
まとめるシート名は1〜5で "4" を除くと仮定しました。面倒ですがコピーするシート名はすべて書き出してください。
Sh = Array("1", "2", "3", "5")
そのほか、lRow、lcolなども修正しています。
以下のコードでいかがですか?
Sub matome2()
Dim Sh
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'sh_check
Worksheets(3).Range("B6:J6").Copy Worksheets(2).Range("A1")
Sh = Array("1", "2", "3", "5")
For i = LBound(Sh) To UBound(Sh)
With Worksheets(Sh(i))
lRow = .Cells(Rows.Count, 2).End(xlUp).Row
lCol = .Cells(6, Columns.Count).End(xlToLeft).Column
If lRow >= 7 Then
lRow2 = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(7, 2), Cells(lRow, lCol)).Copy
Worksheets(2).Cells(lRow2, 1).PasteSpecial xlPasteValues
End If
End With
Next i
Worksheets(2).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub
|