多个excel合为一个execl文件tab分割

喜欢ヅ旅行 2022-05-21 01:22 227阅读 0赞

1.新建一个execl表格，右键下面的tab

![70][]

2.在代码中填写下面代码

'功能：把多个excel工作簿的第一个sheet工作表合并到一个excel工作簿的多个sheet工作表，新工作表的名称等于原工作簿的名称
        Sub Books2Sheets()
         '定义对话框变量
         Dim fd As FileDialog
         Set fd = Application.FileDialog(msoFileDialogFilePicker)
         '新建一个工作簿
         Dim newwb As Workbook
         Set newwb = Workbooks.Add
         With fd
         If .Show = -1 Then
         '定义单个文件变量
         Dim vrtSelectedItem As Variant
         '定义循环变量
         Dim i As Integer
         i = 1
         '开始文件检索
         For Each vrtSelectedItem In .SelectedItems
         '打开被合并工作簿
         Dim tempwb As Workbook
         Set tempwb = Workbooks.Open(vrtSelectedItem)
         '复制工作表
         tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
         '把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx
         newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")
         '关闭被合并工作簿
         tempwb.Close SaveChanges:=False
         i = i + 1
         Next vrtSelectedItem
         End If
         End With
         Set fd = NothingEnd
         End Sub

![70 1][]

3.点击运行，弹出弹窗选择合并的文件

![70 2][]

4.完成

[70]: /images/20220521/98a403b07aa3428c99d163ec5dbf52ea.png
[70 1]: /images/20220521/c908df6088b845f6810ff290f8e1cfa6.png
[70 2]: /images/20220521/67df0b0ecc424a989b6f285445f90432.png