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
’ 循環(huán)選擇的工作簿里的所有工作表
? ? ? ? ? ? Sht.Range("a1:z1").Copy sht1.Range("a1")
' 復制到第一行到sht1里
? ? ? ? ? ? i = Sht.Range("a65536").End(xlUp).Row
'? i為循環(huán)到的這張表有內容的最后一行
? ? ? ? ? ? j = sht1.Range("a65536").End(xlUp).Row
'? ?j 為sht1有內容的最后一行
? ? ? ? ? ? Sht.Range("a2:z" & i).Copy sht1.Range("a" & j + 1)
'? ?循環(huán)到的這張表第二行到下面有文字的所有行都復制到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 '加上以后防止點了取消發(fā)生的錯誤
Set wb1 = ActiveWorkbook
Set sht1 = ActiveSheet
On Error Resume Next
str = Application.GetOpenFilename("Excel數(shù)據(jù)文件,*.xls*", , , , True)
' true 代表可多選工作簿??"Excel數(shù)據(jù)文件,*.xls*" 顯示類型為xls的文件
? ? For i = LBound(str) To UBound(str)
'??LBound(str)? 數(shù)組下限??UBound(str) 數(shù)組上限
? ? ? ? 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