一、合并工作表（合并同一個工作簿中的100個工作表，這100個工作表表頭都一樣）

Sub 合并工作表()
Dim ws As Worksheet
Dim wsMerged As Worksheet
Dim rng As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i As Long

' 創(chuàng)建一個新的工作表用于存放合并后的數據
Set wsMerged = ThisWorkbook.Worksheets.Add
wsMerged.Name = '合并后的工作表'

' 遍歷工作簿中的所有工作表
For Each ws In ThisWorkbook.Worksheets
' 跳過合并后的工作表
If ws.Name <> '合并后的工作表' Then
' 獲取當前工作表的最后一行和最后一列
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

' 復制當前工作表的數據到合并后的工作表
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
rng.Copy Destination:=wsMerged.Cells(wsMerged.Cells(wsMerged.Rows.Count, 1).End(xlUp).Row 1, 1)
End If
Next ws

' 刪除合并后的工作表中的空白行
lastRow = wsMerged.Cells(wsMerged.Rows.Count, 1).End(xlUp).Row
For i = lastRow To 1 Step -1
If Application.WorksheetFunction.CountA(wsMerged.Rows(i)) = 0 Then
wsMerged.Rows(i).Delete
End If
Next i
End Sub

二、合并工作簿

Sub MergeWorkbooks()
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rngSource As Range
Dim rngDest As Range
Dim lastRow As Long
Dim filePath As String

' 假設目標工作簿已經打開，并且名為'MergedData.xlsx'
Set wbDest = Workbooks('MergedData.xlsx')

' 遍歷文件夾中的所有Excel文件
filePath = 'C:\Path\To\Your\Files\' ' 替換為你的文件夾路徑
fileName = Dir(filePath & '*.xlsx')

Do While fileName <> ''
If fileName <> 'MergedData.xlsx' Then ' 排除目標工作簿
' 打開源工作簿
Set wbSource = Workbooks.Open(filePath & fileName)

' 遍歷源工作簿中的每個工作表
For Each wsSource In wbSource.Sheets
' 假設數據從A1開始
Set rngSource = wsSource.Range('A1').CurrentRegion
' 找到目標工作簿中對應工作表的最后一行
With wbDest.Sheets(wsSource.Name)
lastRow = .Cells(.Rows.Count, 'A').End(xlUp).Row 1
End With
' 復制并粘貼到目標工作簿的對應工作表
rngSource.Copy Destination:=wbDest.Sheets(wsSource.Name).Cells(lastRow, 1)
Next wsSource

' 關閉源工作簿，不保存更改
wbSource.Close False
End If
' 獲取下一個文件名
fileName = Dir()
Loop
End Sub

三、100個word文檔合并為1個

Sub 合并Word文檔()
Dim fso As Object
Dim f As Object
Dim wdDoc As Object
Dim wdApp As Object

' 設置Word應用
Set wdApp = CreateObject('Word.Application')
' 打開一個新的Word文檔
Set wdDoc = wdApp.Documents.Add

' 設置文件系統(tǒng)對象
Set fso = CreateObject('Scripting.FileSystemObject')

' 定義文件夾路徑和文件名
Dim folderPath As String
folderPath = 'C:\路徑\Word文檔\' ' 更改為你的文件夾路徑
Dim fileNames As Variant
fileNames = Split(fso.GetFile(folderPath & '*.docx').Path, '\')

' 合并文檔
Dim i As Integer
For i = 0 To UBound(fileNames)
If InStr(fileNames(i), '.docx') > 0 Then
' 打開要合并的文檔
Set wdDocTemp = wdApp.Documents.Open(folderPath & fileNames(i))
' 復制內容到新文檔
wdDocTemp.Range.Copy wdDoc.Range
' 關閉臨時文檔
wdDocTemp.Close False
End If
Next i

' 保存合并后的文檔
wdDoc.SaveAs folderPath & '合并后的文檔.docx'

' 關閉Word應用
wdApp.Quit
Set wdApp = Nothing
Set fso = Nothing
End Sub

四、把100個ppt中所有幻燈片合并到一個ppt中去

Sub 合并PPT()
Dim 目標PPT As Presentation
Dim 源PPT As Presentation
Dim 文件路徑 As String
Dim 文件名 As String
Dim i As Integer

' 設置目標PPT文件路徑
文件路徑 = 'C:\合并的PPT\' ' 更改為你的目標文件夾路徑

' 創(chuàng)建新的PPT文件
Set 目標PPT = Presentations.Add(文件路徑 & '合并后的PPT.pptx')

' 循環(huán)遍歷所有PPT文件
For i = 1 To 100
' 構建源PPT文件名稱
文件名 = 'C:\合并的PPT\' & 'PPT' & i & '.pptx'

' 打開源PPT文件
Set 源PPT = Presentations.Open(文件名)

' 將源PPT中的所有幻燈片復制到目標PPT
For Each Slide In 源PPT.Slides
目標PPT.Slides.Insert(After:=目標PPT.Slides.Count).ShapeRange.CopyFromSlide(Slide.ID)
Next Slide

' 關閉源PPT文件
源PPT.Close
Next i

' 保存合并后的PPT文件
目標PPT.Save

' 清理
Set 源PPT = Nothing
Set 目標PPT = Nothing

' 完成提示
MsgBox 'PPT文件合并完成！'
End Sub