vba 快速合并当前文件夹内多个excel的指定工作表到一个同名工作表并打开,避免内容为空及提示下标越界
时间: 2024-01-29 19:03:23 浏览: 202
你可以使用以下的 VBA 代码实现:
```VBA
Sub MergeWorksheets()
Dim folderPath As String
Dim targetWorksheetName As String
Dim targetWorksheet As Worksheet
Dim sourceWorkbook As Workbook
Dim sourceWorksheet As Worksheet
Dim targetRow As Long
'获取当前文件夹路径
folderPath = ThisWorkbook.Path
'获取目标工作表名称
targetWorksheetName = ActiveSheet.Name
'创建目标工作表
Set targetWorksheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
targetWorksheet.Name = targetWorksheetName
'循环遍历当前文件夹内所有Excel文件
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
filename = Dir(folderPath & "*.xlsx")
Do While filename <> ""
'打开Excel文件
Set sourceWorkbook = Workbooks.Open(folderPath & filename)
'循环遍历所有工作表
For Each sourceWorksheet In sourceWorkbook.Worksheets
'判断工作表名称是否与目标工作表名称相同
If sourceWorksheet.Name = targetWorksheetName Then
'将非空内容复制到目标工作表
sourceWorksheet.UsedRange.Copy
targetRow = targetWorksheet.Cells(Rows.Count, "A").End(xlUp).Row
targetWorksheet.Cells(targetRow + 1, "A").PasteSpecial xlPasteAll
End If
Next sourceWorksheet
'关闭Excel文件
sourceWorkbook.Close False
'获取下一个Excel文件名
filename = Dir()
Loop
'清除剪贴板内容
Application.CutCopyMode = False
'选中目标工作表第一个单元格
targetWorksheet.Cells(1, 1).Select
End Sub
```
将以上代码复制到一个新的 VBA 模块中,然后在需要执行合并操作的 Excel 文件中按下 Alt + F8 快捷键,选择 `MergeWorksheets` 宏,点击运行即可。请注意备份文件,以防数据丢失。
阅读全文