エクセルVBAについて質問です。

次のマクロでどうでしょうか。

前類似のマクロを作ったことがありました。→前は、シート名を入れずに全部を集合させて、集合元のシートは削除してしまうものでした。

※集合シート名やシート名を入れる列の場所は、適宜変更ください。

'変数は必ず定義
Option Explicit

Sub シートを一つにまとめる()
' すべてのシートを「全部」シートにまとめる
    
    Const sTotalShtName As String = "全部"  '集合シート名
    Const sNameCol As String = "Q"          'シート名を入れる列
    Dim iSheetCNT As Integer    'sheetの個数
    Dim i As Integer
    Dim lCurRow As Long         '付け加えるsheetの行数
    Dim lTotalRow As Long       '集合シートの追加する行位置
    
    '全シート数を取り出し
    iSheetCNT = Sheets.Count
    '後ろへシートを追加して名前を変更
    Sheets.Add After:=Sheets(iSheetCNT)
    ActiveSheet.Name = sTotalShtName
    lTotalRow = 1

    For i = 1 To iSheetCNT
        'Copy元を選択してデータがある範囲をコピーする
        Worksheets(i).Select
        'シート見出しが色なしの場合だけ処理
        If ActiveSheet.Tab.ColorIndex = xlColorIndexNone Then
            Range("A1", ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address).Select
            Selection.Copy
            'コピーした行数を記憶しておく
            lCurRow = Selection.Areas(1).Cells.Rows.Count
            'Copy先へ貼り付け（A列の追加行位置へ）
            Sheets(sTotalShtName).Select
            Range("A" & CStr(lTotalRow)).Select
            ActiveSheet.Paste
            '指定列へシート名を入れる（今回貼り付けの範囲へ）
            Range(sNameCol & lTotalRow, sNameCol & (lTotalRow + lCurRow)) = Worksheets(i).Name
            '集合シートは次の行位置に進める
            lTotalRow = lTotalRow + lCurRow
        End If
    Next i
    Range("A1").Select

End Sub