合并excel的vba程序

功能：把多个excel工作簿的第一个sheet工作表合并到一个excel工作簿的多个sheet工作表，新工作表的名称等于原工作簿的名称

一、EXCEL版

'功能：把多个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, ".xlsx", "")
          '关闭被合并工作簿
          tempwb.Close SaveChanges:=False
          i = i + 1
          Next vrtSelectedItem
          
          End If
          
   End With
   Set fd = Nothing
      
   End Sub

二、WPS版

Sub MergeAllFiles()
Dim MyFolder As String
Dim MyFile As String
Dim SourceWorkbook As Workbook
Dim DestinationWorkbook As Workbook
MyFolder = InputBox("请输入要整合的文件夹路径：")
MyFile = Dir(MyFolder & "\*.xlsx")
Set DestinationWorkbook = Workbooks.Add
Do While MyFile <> ""
   Workbooks.Open Filename:=MyFolder & "\" & MyFile
    For Each SourceWorksheet In ActiveWorkbook.Worksheets
        SourceWorksheet.Copy After:= _
        DestinationWorkbook.Sheets(DestinationWorkbook.Sheets.Count)
    Next SourceWorksheet
    Workbooks(MyFile).Close
    MyFile = Dir
Loop
End Sub