Sub 複数シートを新規ブック1シートにまとめる改()

    '宣言
    Dim LastRw1 As Long '元データの最終行
    Dim LastRw2 As Long '新規ブックの最終行
   
    Dim i As Integer
    Dim j As Integer
    Dim k As Long   '件数カウント用
   
    Dim oldBK As Workbook   '元データのブックの意味
    Dim newBK As Workbook   '新しいブックの意味
   
    'ブックを変数に格納
    Set oldBK = ActiveWorkbook  '元データはoldBKに
    Set newBK = Workbooks.Add   '新規ブックはnewBKに
   
   
    '元データをアクティブに
    oldBK.Activate
   
    'ヘッダーをつける
    Sheets(1).Select
    ActiveWorkbook.Sheets(1).Columns.Hidden = False '隠れた列があったら表示
    Rows(1).Copy Destination:=newBK.Sheets(1).Cells(1, 1)
   
    'シート数数える　この数だけループさせる
    j = Sheets.Count
   
    'ループその１
    i = 1
    Do Until i > j
       
        Sheets(i).Select
       
        '隠れた列を見せます
        ActiveWorkbook.Sheets(i).Columns.Hidden = False
               
        'フィルタがもしかかっていたら、全セル見せます
        If ActiveWorkbook.Sheets(i).FilterMode = True Then
            ActiveWorkbook.Sheets(i).ShowAllData
        End If

        '元データの最終行を取得
        LastRw1 = Cells(Rows.Count, 1).End(xlUp).Row
       
        '新規ブックの最終行を取得
        LastRw2 = newBK.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
       
        '条件　もし元データのシートが空でない（＝２行以上ある）なら、
        '元データの２行目から最終行までをコピーし、
        '新規ブックの最終行プラス１行目に貼り付ける
        If LastRw1 >= 2 Then
            Range(Rows(2), Rows(LastRw1)).Copy Destination:=newBK.Sheets(1).Cells(LastRw2 + 1, 1)
        End If
        　i = i + 1
        '件数カウント
        　k = k + (LastRw1 - 1)           
    Loop
    newBK.Activate
    　MsgBox "全部で　" & k & "　件です"   
End Sub