VBA汇总文件夹中的多文件的工作表中不同单元格区域到总表
【问题】我们发了这样一个表格到各单位收集资料，各单位填写完后上交上来有许多个文件，我们现在想汇总成一年一个表，怎么办？
◆表格是先设定后的一样的格式
◆收上来后有很多个文件
◆我们想汇总成这样的“一年一个汇总表”
【难点】正常的做法是一个文件打开---复制2016年的—粘贴………再复制2017年的—粘贴…………再复制2018年的—粘贴，----关闭文件，再打开一个文件………………
如果几个文件还好，如果是一百多个，1k个呢,1w个呢，！那就加班，再加班
【解决问题】我们的口号是VBA使工作效率提高，不加班
====【代码】====
代码语言：javascript复制Sub 提取多文件一工作表中不同区域汇总()
Dim fileToOpen, x, total_file_path, m, title_row
Dim MyOb As Object, rng As Range ', rng_1 As Range, rng_2 As Range
Dim sht2016 As Worksheet, sht2017 As Worksheet, sht2018 As Worksheet
fileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "打开文件", , True)
If TypeName(fileToOpen) = "Boolean" Then MsgBox "你选择了“取消”,将要退出程序": Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set sht2016 = Worksheets("2016")
Set sht2017 = Worksheets("2017")
Set sht2018 = Worksheets("2018")
sht2016.Range("a5:t300").Clear
sht2017.Range("a5:t300").Clear
sht2018.Range("a5:t300").Clear
m = 0
On Error Resume Next
For Each rr In fileToOpen
Set MyObj = GetObject(rr)
With MyObj
With MyObj.Worksheets("Sheet1")
.Range("a5:t11").Copy
Lrow = sht2016.Cells.Find("*", Cells(1, 1), , , 1, 2).Row 1
sht2016.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
.Range("a17:t23").Copy
Lrow = sht2017.Cells.Find("*", Cells(1, 1), , , 1, 2).Row 1
sht2017.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
.Range("a29:t35").Copy
Lrow = sht2018.Cells.Find("*", Cells(1, 1), , , 1, 2).Row 1
sht2018.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
m = m 1
End With
.Close False
End With
Set MyObj = Nothing
Next
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完成！共汇总文件数：" & m
End Sub====【解析】====
1. 用Application.GetOpenFilename打开一个选择文件的对话框，可以多选，把选择的文件存入到fileToOpen的数据中
2.循环数组，
3.打开一个文件，并复制全部的区域，到指定的2016-2018的表格中，下一次的复制，复制到最后的一行中的A列中，
4.因为在打开文件的过程中可能有些人在传输文件中，文件损坏了，所以加上On Error Resume Next，不报错继续运行。到时汇总完成了再来检查那个文件坏了。
====【遇到的坑】====
本来我想打开一个文件，再用Union所在的区域，最后再复制，但这里遇到问题，也算是学习了，
代码如下：
代码语言：javascript复制 '用GetObject打开文件后
If rn Is Nothing Then
Set rn = .Range("a5:t11")
Else
Set rn = Union(rn, .Range("a5:t11"))
End If
'再关闭文件，再循环一次
'文件循环完成后，判断并且复制
If Not rn Is Nothing Then
rn.Copy .Range("A6")
End If结果发现是不可行的，原因是：初值中是.Range("a5:t11")，想要组合进行的也是.Range("a5:t11")，所以程序是不可以的。这里留下个记号吧！
====【效果】====
最后完成
====今天就学习至此====
