一、合并工作表（合并同一個(gè)工作簿中的100個(gè)工作表，這100個(gè)工作表表頭都一樣）
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)建一個(gè)新的工作表用于存放合并后的數(shù)據(jù)
Set wsMerged = ThisWorkbook.Worksheets.Add
wsMerged.Name = '合并后的工作表'
' 遍歷工作簿中的所有工作表
For Each ws In ThisWorkbook.Worksheets
' 跳過合并后的工作表
If ws.Name <> '合并后的工作表' Then
' 獲取當(dāng)前工作表的最后一行和最后一列
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' 復(fù)制當(dāng)前工作表的數(shù)據(jù)到合并后的工作表
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
' 假設(shè)目標(biāo)工作簿已經(jīng)打開，并且名為'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 ' 排除目標(biāo)工作簿
' 打開源工作簿
Set wbSource = Workbooks.Open(filePath & fileName)
' 遍歷源工作簿中的每個(gè)工作表
For Each wsSource In wbSource.Sheets
' 假設(shè)數(shù)據(jù)從A1開始
Set rngSource = wsSource.Range('A1').CurrentRegion
' 找到目標(biāo)工作簿中對應(yīng)工作表的最后一行
With wbDest.Sheets(wsSource.Name)
lastRow = .Cells(.Rows.Count, 'A').End(xlUp).Row 1
End With
' 復(fù)制并粘貼到目標(biāo)工作簿的對應(yīng)工作表
rngSource.Copy Destination:=wbDest.Sheets(wsSource.Name).Cells(lastRow, 1)
Next wsSource
' 關(guān)閉源工作簿，不保存更改
wbSource.Close False
End If
' 獲取下一個(gè)文件名
fileName = Dir()
Loop
End Sub
三、100個(gè)word文檔合并為1個(gè)
Sub 合并Word文檔()
Dim fso As Object
Dim f As Object
Dim wdDoc As Object
Dim wdApp As Object
' 設(shè)置Word應(yīng)用
Set wdApp = CreateObject('Word.Application')
' 打開一個(gè)新的Word文檔
Set wdDoc = wdApp.Documents.Add
' 設(shè)置文件系統(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))
' 復(fù)制內(nèi)容到新文檔
wdDocTemp.Range.Copy wdDoc.Range
' 關(guān)閉臨時(shí)文檔
wdDocTemp.Close False
End If
Next i
' 保存合并后的文檔
wdDoc.SaveAs folderPath & '合并后的文檔.docx'
' 關(guān)閉Word應(yīng)用
wdApp.Quit
Set wdApp = Nothing
Set fso = Nothing
End Sub
四、把100個(gè)ppt中所有幻燈片合并到一個(gè)ppt中去
Sub 合并PPT()
Dim 目標(biāo)PPT As Presentation
Dim 源PPT As Presentation
Dim 文件路徑 As String
Dim 文件名 As String
Dim i As Integer
' 設(shè)置目標(biāo)PPT文件路徑
文件路徑 = 'C:\合并的PPT\' ' 更改為你的目標(biāo)文件夾路徑
' 創(chuàng)建新的PPT文件
Set 目標(biāo)PPT = Presentations.Add(文件路徑 & '合并后的PPT.pptx')
' 循環(huán)遍歷所有PPT文件
For i = 1 To 100
' 構(gòu)建源PPT文件名稱
文件名 = 'C:\合并的PPT\' & 'PPT' & i & '.pptx'
' 打開源PPT文件
Set 源PPT = Presentations.Open(文件名)
' 將源PPT中的所有幻燈片復(fù)制到目標(biāo)PPT
For Each Slide In 源PPT.Slides
目標(biāo)PPT.Slides.Insert(After:=目標(biāo)PPT.Slides.Count).ShapeRange.CopyFromSlide(Slide.ID)
Next Slide
' 關(guān)閉源PPT文件
源PPT.Close
Next i
' 保存合并后的PPT文件
目標(biāo)PPT.Save
' 清理
Set 源PPT = Nothing
Set 目標(biāo)PPT = Nothing
' 完成提示
MsgBox 'PPT文件合并完成！'
End Sub
