如何合并或合并 Excel 工作表

Question

我有 70 个 Excel 文件，每个 Excel 工作簿中有 10 个工作表。

但是每个工作簿都有相同的工作表名称，例如{ Excel 1: JAN , Feb , March } & { Excel 2 : Jan , Feb , March } & { Excel 3 : Jan , Feb , March }。 Excel 保存在一个文件夹中。

如何通过表格名称合并 Excel。我想复制和粘贴表格 JAN 到 JAN、FEB 到 FEB、March 到 March 等数据。使用 VBA 宏或任何其他方式一次性按名称合并或复制和粘贴所有 Excel 工作表。

Answer 1

你可以试试下面的代码。

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As 
Object
Application.ScreenUpdating = False
Workbooks.Open Filename:="D:\Automation Tool\Report - Template.xlsx"
Windows("Report - Template.xlsx").Activate
With ActiveWorkbook
    Worksheets("Lev Report").Activate
End With
Rows("2:" & Rows.Count).ClearContents
Range("A2").Select
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("D:\Automation Tool\Leave Report\Leave File")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
Windows("Leave Report - Template.xlsx").Activate
ActiveWorkbook.Worksheets(2).Activate

'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
Call ChangeCaches
End Sub

Answer 2

在运行脚本之前，您需要设置配置 (MergeExcel.txt) 文件。在 Windows 资源管理器中按住 shift 并右键单击要合并的文件，选择“复制为路径”。将路径粘贴到 MergeExcel.txt 文件中。文件中的每个文件都是要合并的excel文件的路径。配置必须与 VBS 脚本位于同一文件夹中。

c:\folder1\Excel1.xlsx
c:\folder1\Excel2.xlsx
c:\folder3\Excel3.xlsx

双击运行 MergeExcel.vbs。该脚本将读取位于同一文件夹中的 MergeExcel.txt 文件并将所有工作表导入到一个工作簿中。该脚本使用 VBA 打开 Excel 并导入工作表。

Set fso = CreateObject("Scripting.FileSystemObject")
sFolderPath = GetFolderPath()
sFilePath = sFolderPath & "\MergeExcel.txt"

If fso.FileExists(sFilePath) = False Then
  MsgBox "Could not file configuration file: " & sFilePath
  WScript.Quit
End If

Dim oExcel: Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = false
Set oMasterWorkbook = oExcel.Workbooks.Add()
Set oMasterSheet = oMasterWorkbook.Worksheets("Sheet1")
oMasterSheet.Name = "temp_delete"
oMasterWorkbook.Worksheets("Sheet2").Delete
oMasterWorkbook.Worksheets("Sheet3").Delete

Set oFile = fso.OpenTextFile(sFilePath, 1)   
Do until oFile.AtEndOfStream
  sFilePath = Replace(oFile.ReadLine,"""","")
  
  If fso.FileExists(sFilePath) Then
    Set oWorkBook = oExcel.Workbooks.Open(sFilePath)
    
    For Each oSheet in oWorkBook.Worksheets
      oSheet.Copy oMasterSheet
      'oSht.Move , oSheet
    Next
    
    oWorkBook.Close()
  End If
Loop
oFile.Close

oMasterSheet.Delete
MsgBox "Done"
          
Function GetFolderPath()
    Dim oFile 'As Scripting.File
    Set oFile = fso.GetFile(WScript.ScriptFullName)
    GetFolderPath = oFile.ParentFolder
End Function