一、将一个工作簿中所有工作表单独保存为独立的文件
操作过程分三步:选中要复制的sheet,,复制(建立副本),保存后关闭新文件
Sub sheet2file()Dim sht As WorksheetDim 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 /*关闭窗口*/NextEnd Sub
二、从独立工作簿复制合并到工作表
step1: 批量建工作表
参考:/weixin_40844116/article/details/94614531
step2:复制内容到对应sheet
情况1:默认文件名和sheet名一致
Sub file2sheet()Dim sht As WorksheetDim file As WorkbookDim new_name$For Each sht In Sheetsfile_name = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"/*拼接文件名,默认文件名和sheet名一致*/Set file = GetObject(file_name)/*获取文件对象*/file.Sheets(1).Cells.Copy sht.Cells(1, 1)/*复制单元格到对应sheet*/NextEnd Sub
情况2:文件名和sheet名不一致
如果文件名和sheet名不一致,那么文件名就不该由sht.Name拼接,需要自定义
1.把所有的sheet列出来
Sub list_sheet()For i = 1 To ThisWorkbook.Sheets.CountThisWorkbook.Sheets(1).Cells(i, 1) = ThisWorkbook.Sheets(i).NameNext iEnd Sub
或者
Sub list_sheet2()Dim sht As WorksheetFor Each sht In Sheets ThisWorkbook.Sheets(1).Cells(sht.Index, 1) = sht.NameNextEnd Sub
2.复制内容
sheet1定义了文件的对应关系,因此不能有内容复制到该页将其覆盖,需从第二页开始复制粘贴。如果文件原来没有sheet1,可以新建。
Sub copysheet()Dim file As WorkbookDim 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 nEnd Sub
当然,很多情况下,需要复制粘贴的sheet不是连续的,但是只需要在sheet1中定义好就可以
Sub copysheet2()Dim file As WorkbookDim 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 nEnd Sub