GetOpenFilename
合并选择的excel文件下所有的工作簿
Sub test()
Dim str As String
Dim wb As Workbook
Dim Sht, sht1 As Worksheet
Dim i, j
Set sht1 = ActiveSheet
' 将活动工作簿写入sht1，不要忘记用set写入
str = Application.GetOpenFilename
' 将所选的文件名写入str，此处为单选
If str <> "False" Then
' 如果str不是错误也就是如果用户选择了文件
Set wb = Workbooks.Open(str)
' 将选择的工作簿打开写入到wb 里
For Each Sht In wb.Sheets
’ 循环选择的工作簿里的所有工作表
Sht.Range("a1:z1").Copy sht1.Range("a1")
' 复制到第一行到sht1里
i = Sht.Range("a65536").End(xlUp).Row
' i为循环到的这张表有内容的最后一行
j = sht1.Range("a65536").End(xlUp).Row
' j 为sht1有内容的最后一行
Sht.Range("a2:z" & i).Copy sht1.Range("a" & j + 1)
' 循环到的这张表第二行到下面有文字的所有行都复制到sht1里的有文字的最后一行的下一行
Next
wb.Close
' 关闭选择的表
End If
End Sub
合并选择的多个excel文件下所有的工作表合并到一个工作簿里
Sub test()
Dim str()
Dim i As Integer
Dim wb, wb1 As Workbook
Dim sht As Worksheet
On Error Resume Next '加上以后防止点了取消发生的错误
Set wb1 = ActiveWorkbook
Set sht1 = ActiveSheet
On Error Resume Next
str = Application.GetOpenFilename("Excel数据文件,*.xls*", , , , True)
' true 代表可多选工作簿 "Excel数据文件,*.xls*" 显示类型为xls的文件
For i = LBound(str) To UBound(str)
' LBound(str) 数组下限 UBound(str) 数组上限
Set wb = Workbooks.Open(str(i))
For Each sht In wb.Sheets
sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
wb1.Sheets(wb1.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
Next
wb.Close
Next
End Sub