一、将一个工作簿中所有工作表单独保存为独立的文件

操作过程分三步：选中要复制的sheet,，复制（建立副本），保存后关闭新文件

Sub sheet2file()
    Dim sht As Worksheet
    Dim file_name$
    For Each sht In Sheets/*所有sheet遍历*/
        sht.Copy /*复制sheet，如果是移动则用move*/
        file_name = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"/*拼接新文件的完整路径文件名*/
        ActiveWorkbook.SaveAs Filename:=file_name, FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False /*保存*/
        ActiveWindow.Close /*关闭窗口*/
    Next

End Sub

二、从独立工作簿复制合并到工作表

step1: 批量建工作表

参考：https://blog.csdn.net/weixin_40844116/article/details/94614531

step2:复制内容到对应sheet

情况1：默认文件名和sheet名一致

Sub file2sheet()
    Dim sht As Worksheet
    Dim file As Workbook
    Dim new_name$
    For Each sht In Sheets
        file_name = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"/*拼接文件名，默认文件名和sheet名一致*/
        Set file = GetObject(file_name)/*获取文件对象*/
        file.Sheets(1).Cells.Copy sht.Cells(1, 1)/*复制单元格到对应sheet*/
    Next
        

End Sub

情况2：文件名和sheet名不一致
如果文件名和sheet名不一致，那么文件名就不该由sht.Name拼接，需要自定义
1.把所有的sheet列出来

Sub list_sheet()
    For i = 1 To ThisWorkbook.Sheets.Count
    ThisWorkbook.Sheets(1).Cells(i, 1) = ThisWorkbook.Sheets(i).Name
    Next i
End Sub

或者

Sub list_sheet2()
    Dim sht As Worksheet
    For Each sht In Sheets    
        ThisWorkbook.Sheets(1).Cells(sht.Index, 1) = sht.Name
    Next
End Sub

2.复制内容
sheet1定义了文件的对应关系，因此不能有内容复制到该页将其覆盖，需从第二页开始复制粘贴。如果文件原来没有sheet1,可以新建。

Sub copysheet()

     Dim file As Workbook
     Dim file_name$
     For n = 2 To (ThisWorkbook.Sheets.Count - 1)/*从第2行到最后一行，最后一行也可以用【Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))】非空单元格计数*/
        file_name = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(1).Cells(n, 2) & ".xlsx"
        Set file = GetObject(file_name)
        file.Sheets(1).Cells.Copy ThisWorkbook.Sheets(n).Cells(1, 1)/*从文件的sheets(1)复制内容到对应sheet*/

     Next n
     
End Sub

当然，很多情况下，需要复制粘贴的sheet不是连续的，但是只需要在sheet1中定义好就可以

Sub copysheet2()

     Dim file As Workbook
     Dim file_name$
     Dim numb$
     For n = 2 To 5/*这里的5可以是手数，也可以用计数函数【Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))】*/
        file_name = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(1).Cells(n, 2) & ".xlsx"
        'MsgBox (Sheets(n).Index)
        Set file = GetObject(file_name)
        numb = ThisWorkbook.Sheets(1).Cells(n, 1)/*获取单元格内容，作为工作表的索引*/
        file.Sheets(1).Cells.Copy ThisWorkbook.Sheets(numb).Cells(1, 1)/*引用单元格内容作为索引，让文件内容复制到对应名称的sheet上去*/

     Next n
     
End Sub