日志
将多个excel合并为1个excel
Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName ‘定义变量，但未指定变量类型，这样一般是不规范的
Dim Wb As Workbook, WbN As String ‘定义变量wb为工作簿类型，wbn为字符型
Dim G As Long ‘定义G为长整型
Dim Num, ini As Long ’定义num，并定义和声明ini为长整型（注意，num类型未定）
Application.ScreenUpdating = False ‘关闭屏幕刷新
MyPath = ActiveWorkbook.Path ‘将当前工作簿的路径赋值给mypath
MyName = Dir(MyPath & "\" & "*.xls") ’将活动工作簿的名字加上.xls后赋值给myname
AWbName = ActiveWorkbook.Name ‘将激活工作簿的文件名赋值给awbname
Num = 0
ini = 0
Do While MyName <> "" '运行下面的do while循环，直到myname的值为空。
If MyName <> AWbName Then ’如果myname与awbname的值不同，则运行下一个end if前的语句
Set Wb = Workbooks.Open(MyPath & "\" & MyName) 打开mypath路径下名字为myname变量值的工作簿，并将其赋给wb
Num = Num + 1 ‘对num累加
With Workbooks(1).ActiveSheet ’对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句
If ini = 0 Then
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1, 1),Wb.Sheets(1).Cells(1,Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1) ’将wb工作簿中第一个工作表的第一行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
ini=1
End If
For G=1 To Sheets.Count ‘在Workbooks(1).ActiveSheet的所有sheet中循环。
Wb.Sheets(G).Range(Wb.Sheets(G).Cells(2,1),Wb.Sheets(G).Cells(Wb.Sheets(G).UsedRange.Rows.Count,Wb.Sheets(G).UsedRange.Columns.Count)).Copy .Cells(.Range("A65536").End(xlUp).Row+1,1) ’将WB中的A2到最后一行最后一列的非空单元格的内容复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴
Next
WbN=WbN & Chr(13) & Wb.Name ‘将wbn的值加上空格和wb的名称后赋值给wbn
Wb.Close False ’将wb关闭
End With
End If
Dim MyPath, MyName, AWbName ‘定义变量，但未指定变量类型，这样一般是不规范的
Dim Wb As Workbook, WbN As String ‘定义变量wb为工作簿类型，wbn为字符型
Dim G As Long ‘定义G为长整型
Dim Num, ini As Long ’定义num，并定义和声明ini为长整型（注意，num类型未定）
Application.ScreenUpdating = False ‘关闭屏幕刷新
MyPath = ActiveWorkbook.Path ‘将当前工作簿的路径赋值给mypath
MyName = Dir(MyPath & "\" & "*.xls") ’将活动工作簿的名字加上.xls后赋值给myname
AWbName = ActiveWorkbook.Name ‘将激活工作簿的文件名赋值给awbname
Num = 0
ini = 0
Do While MyName <> "" '运行下面的do while循环，直到myname的值为空。
If MyName <> AWbName Then ’如果myname与awbname的值不同，则运行下一个end if前的语句
Set Wb = Workbooks.Open(MyPath & "\" & MyName) 打开mypath路径下名字为myname变量值的工作簿，并将其赋给wb
Num = Num + 1 ‘对num累加
With Workbooks(1).ActiveSheet ’对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句
If ini = 0 Then
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1, 1),Wb.Sheets(1).Cells(1,Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1) ’将wb工作簿中第一个工作表的第一行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
ini=1
End If
For G=1 To Sheets.Count ‘在Workbooks(1).ActiveSheet的所有sheet中循环。
Wb.Sheets(G).Range(Wb.Sheets(G).Cells(2,1),Wb.Sheets(G).Cells(Wb.Sheets(G).UsedRange.Rows.Count,Wb.Sheets(G).UsedRange.Columns.Count)).Copy .Cells(.Range("A65536").End(xlUp).Row+1,1) ’将WB中的A2到最后一行最后一列的非空单元格的内容复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴
Next
WbN=WbN & Chr(13) & Wb.Name ‘将wbn的值加上空格和wb的名称后赋值给wbn
Wb.Close False ’将wb关闭
End With
End If
MyName=Dir
Loop
Range("A1").Select ‘选中当前工作簿的第一个单元格
Application.ScreenUpdating = True ’开启屏幕刷新
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"‘给出最后提示
End Sub
这个程序有点问题：ActiveWorkbook的相关语句有点杂乱。一不留神将会导致数据紊乱。建议：指定需要操作的相应工作簿或工作表，而放弃用Active指定的形式。
Loop
Range("A1").Select ‘选中当前工作簿的第一个单元格
Application.ScreenUpdating = True ’开启屏幕刷新
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"‘给出最后提示
End Sub
这个程序有点问题：ActiveWorkbook的相关语句有点杂乱。一不留神将会导致数据紊乱。建议：指定需要操作的相应工作簿或工作表，而放弃用Active指定的形式。
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 + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub