VBA—GetOpenFilename|VBA—GetOpenFilename 介绍
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
【VBA—GetOpenFilename|VBA—GetOpenFilename 介绍】End Sub
推荐阅读
- 急于表达——往往欲速则不达
- 慢慢的美丽
- 《真与假的困惑》???|《真与假的困惑》??? ——致良知是一种伟大的力量
- 2019-02-13——今天谈梦想（）
- 考研英语阅读终极解决方案——阅读理解如何巧拿高分
- Ⅴ爱阅读，亲子互动——打卡第178天
- 低头思故乡——只是因为睡不着
- 取名——兰
- 每日一话（49）——一位清华教授在朋友圈给大学生的9条建议
- 广角叙述|广角叙述 展众生群像——试析鲁迅《示众》的展示艺术