900字范文,内容丰富有趣,生活中的好帮手!
900字范文 > 【Excel VBA】批量拆分工作表为独立文件批量复制文件内容到总文件的工作表

【Excel VBA】批量拆分工作表为独立文件批量复制文件内容到总文件的工作表

时间:2021-06-02 20:09:44

相关推荐

【Excel VBA】批量拆分工作表为独立文件批量复制文件内容到总文件的工作表

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

操作过程分三步:选中要复制的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

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。