以下是对网上大牛给出的vba源码,经过查阅资料和实践后给出的逻辑分析:
=======================================================
Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName ‘定义这三个变量
Dim Wb As Workbook, WbN As String ’定义Wb为工作表,WbN为字符串变量
Dim G As Long ‘定义G为长整型变量
Dim Num As Long ’定义Num为长整型变量
Dim BOX As String ‘定义BOX为字符串变量
Application.ScreenUpdating = False ’关闭屏幕更新
MyPath = ActiveWorkbook.Path ‘赋值MyPath为表格文件路径
MyName = Dir(MyPath & "\" & "*.xls") ’遍历文件夹里所有文件名赋值给MyName
AWbName = ActiveWorkbook.Name ‘活动工作表的名称赋值给AWbName
Num = 0 ’长整型变量Num为0
Do While MyName "" ‘判断条件是否满足,满足就进入MyName的循环
If MyName AWbNameThen‘判断除了活动工作表以外的表格则
Set Wb = Workbooks.Open(MyPath & "\" & MyName) ’
Num = Num + 1 ‘计数+1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) ’确定从A65536范围内以上的最后一行非空单元格+2,1,先复制文件名
For G = 1 To Sheets.Count ‘从第一个表到当前工作簿中全部工作表的总数
Wb.Sheets(G).UsedRange.Copy.Cells(.Range("A65536").End(xlUp).Row + 1, 1)
‘将该工作表可见范围内的单元格内容复制到最后一行非空单元格+1
Next
WbN = WbN & Chr(13) & Wb.Name ’回车,把打开的工作簿名称累计起来存入到WbN字符串中
Wb.Close False ‘关闭该workbook并不保存,True则为保存
End With ’with end with语句可以省略运行对象,直接.Cells()
End If
MyName = Dir '第二次调用 Dir 函数,但不带任何参数,则函数将返回同一目录下的下一个 *.xls 文件
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub
=======================================================
下面为适应数据处理需要,调整表格的第一列为表格文件名称,所作的修改版:
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("B65536").End(xlUp).Row + 1, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To 1
Wb.Sheets(G).Range("A2:G999").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 2)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
.Range(.Cells([A65536].End(xlUp).Row + 1, 1), .Cells([B65536].End(xlUp).Row, 1)) = Left(MyName, Len(MyName) - 4)
‘注:该行代码不能放在关闭表格前的循环内
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = False
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub
领取专属 10元无门槛券
私享最新 技术干货