Sub A1にまとめる()
Dim mySheet As String
Dim i, j As Long
Dim sheetsCount As Long
Dim lastRow As Long
Dim output As String
Application.ScreenUpdating = False 'マクロを実行中、画面更新を中断
ActiveSheet.EnableCalculation = False '---再計算しない
'Application.ScreenUpdating = True '画面更新
'ActiveSheet.EnableCalculation = True '---再計算する
i = 0
j = 0
lastRow = 0
output = ""
mySheet = ActiveSheet.Name 'シート名を取得
sheetsCount = ActiveWorkbook.Worksheets.Count 'シートの数を取得
For i = 1 To sheetsCount
Worksheets(i).Select 'シートの選択
lastRow = Cells(60000, 1).End(xlUp).Row '最終行を取得
For j = 1 To lastRow
If j <> 1 Then 'A1は除外
output = output & Cells(j, 1) '2〜最終行の文字列を足す
End If
Next
Next
Cells.WrapText = False '折り返しを無くす
Worksheets(mySheet).Activate 'マクロ開始のシートを選択
Cells(1, 1).Select 'A1を選択
Application.ScreenUpdating = True '画面更新
ActiveSheet.EnableCalculation = True '---再計算する
End Sub