具体操作如下:
1、首先把要合并的多个excel表都放在同一个文件夹里面,并在这个文件夹里面新建一个excel。
2、用microsoft excel打开新建的excel表,并右键单击sheet1,找到“查看代码”,单击进去。进去之后就看到了宏计算界面。
3、然后我们把下面这些宏计算的代码复制进去,然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”,代码如下,可直接复制粘贴
Sub 合并当前目录下所有工作簿的全部工作表()
Dim mypath, myname, awbname
Dim wb As Workbook, wbn As String
Dim g As Long
Dim num As Long
Dim box As String
Application.ScreenUpdating = False
mypath = ActiveWorkbook.Path
myname = Dir(mypath & "\" & "*.xls")
awbname = ActiveWorkbook.Name
num = 0
Do While myname <> ""
If myname <> awbname Then
Set wb = Workbooks.Open(mypath & "\" & myname)
num = num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("a65536").End(xlUp).Row + 2, 1) = Left(myname, Len(myname) - 4)
For g = 1 To Sheets.Count
wb.Sheets(g).UsedRange.Copy .Cells(.Range("a65536").End(xlUp).Row + 1, 1)
Next
wbn = wbn & Chr(13) & wb.Name
wb.Close False
End With
End If
myname = Dir
Loop
Range("a1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & num & "个工作薄下的全部工作表。如下:" & Chr(13) & wbn, vbInformation, "提示"
End Sub
那么上面的代码得到的合并在一起的Excel表格表头是重复的,那该怎么去表头呢?
具体的操作方法和上面一样,具体的代码看下面,直接复制就好啦。看下面的代码,下面的代码是只保留一个表头的:
Sub MergeMultiFiles()
Dim filePath As String, fileName As String, mergedWorkbookName As String, processedFileNames As String
Dim Workbook As Workbook
Dim copyRange As Range
Dim i As LongPtr
Dim num As LongPtr
Dim box As String
Dim headerCount As Integer
headerCount = 1 ' 表头行数,根据实际情况设置
Application.ScreenUpdating = False
filePath = ThisWorkbook.Path
fileName = Dir(filePath & "\" & "*.xls")
mergedWorkbookName = ThisWorkbook.Name
num = 0
Do While fileName <> ""
If fileName <> mergedWorkbookName Then
Set Workbook = Workbooks.Open(filePath & "\" & fileName)
num = num + 1
With ThisWorkbook.ActiveSheet
' .Cells(.Range("A65535").End(xlUp).Row + 2, 1).Value = Left(fileName, Len(fileName) - 5)
For i = 1 To Workbook.Sheets.Count
If num = 1 And i = 1 Then
Workbook.Sheets(i).UsedRange.Copy .Cells(1, 1)
Else
Set copyRange = Workbook.Sheets(i).UsedRange
copyRange.Offset(headerCount, 0).Resize(copyRange.Rows.Count - headerCount, copyRange.Columns.Count).Copy .Cells(.Range("A65535").End(xlUp).Row + 1, 1)
End If
Next
End With
processedFileNames = processedFileNames & Chr(13) & Workbook.Name
Workbook.Close False
End If
fileName = Dir()
Loop
UsedRange.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & num & "个工作薄下的全部工作表。文件名如下:" & processedFileNames, vbInformation, "提示"
End Sub
参考文章:
https://www.codeleading.com/article/71383848503/
https://blog.csdn.net/baidu_31950961/article/details/98640001
https://blog.csdn.net/corpse2010/article/details/89850175