Sub フォルダ内の全ブックを1ブック化するマクロ()
	Dim filePathList() As String
    Dim fileName As Variant
    Dim i As Integer: i = 0
    
    '同フォルダ内のExcelファイルを走査してリストを作ります
    fileName = Dir(ThisWorkbook.Path & "\" & "*.xls*")
    Do While fileName <> ""
        If (fileName <> ThisWorkbook.Name) Then '自分は含めない
            ReDim Preserve filePathList(i)
            filePathList(i) = ThisWorkbook.Path & "\" & fileName 'フルパスで
            i = i + 1
        End If
        fileName = Dir()
    Loop
    
    '対象が無かったらやめます
    If (i = 0) Then
        Exit Sub
    End If
    
    '1つ目のブックに全部移動します
    Dim filePath As String
    Dim targetBook As Workbook
    Dim tmpBook As Workbook
    For i = LBound(filePathList) To UBound(filePathList)
        filePath = filePathList(i)
        If (i = 0) Then
            Set targetBook = Workbooks.Open(filePath)
        Else
            Set tmpBook = Workbooks.Open(filePath)
            Sheets().Move After:=targetBook.Sheets(targetBook.Sheets.Count) '末尾に移動
        End If
    Next i

    '別名保存ダイアログを開きます
	Application.GetSaveAsFilename
End Sub