ExcelVBA一键汇总多文件的指定工作表的到一个文件
【问题】下发给下面各单位的表格收集信息资料，上交上来后有很多个文件，文件的内容格式是一样（我下发时定的格式），我想把这些资料汇总在一起，
【传统做法】
打开一个文件—选中要的内容--复制—-粘贴到汇总表—关闭，
再打开一个文件—选中要的内容--复制—粘贴到汇总表—关闭，
再打开一个文件—选中要的内容-复制—粘贴到汇总表--关闭。。。。。天啊有100个，那我是不是要做一天重复再重重复复的工作。
【解决方法】VBA程序请上来帮我
1.把汇总的文件与上交文件放在这里
2.上交文件中全部是上交上来的文件
3.它们的格式是一样的
4.===代码如下=========
Sub 汇总指定文件指定工作表()
With Application.FileDialog(msoFileDialogFolderPicker)
'--------取得用户选择的文件夹路径
.InitialFileName = ThisWorkbook.Path
If .Show Then strPath = .SelectedItems(1) Else Exit Sub
End With
If Right(strPath, 1) <> "" Then strPath = strPath & ""
'MsgBox "选择了：" & Chr(10) & strPath
start_row = Application.InputBox("请输入工作表标题行数：", , 1, , , , , 1)
If start_row = "" Then Exit Sub
'如果按取消就退出
ti = Timer
Application.ScreenUpdating = False '重新打开屏幕更新
Application.DisplayAlerts = False
Set mysht = ActiveSheet
MsgBox mysht.Name
m = 1
mfile = Dir(strPath & "*.xls*")
Do While mfile <> ""
If mfile <> ThisWorkbook.Name Then
' MsgBox strPath & mfile
With GetObject(strPath & mfile)
If m = 1 Then
.Sheets(1).UsedRange.Copy mysht.Range("a1")
Else
mysht_row = mysht.UsedRange.Find("*", , , , 1, 2).Row 1
With .Sheets(1)
L_row = .Cells.Find("*", , , , 1, 2).Row
.Rows(start_row 1 & ":" & L_row).Copy
mysht.Rows(mysht_row).PasteSpecial Paste:=xlPasteAll
End With
End If
.Close False
End With
m = m 1
End If
mfile = Dir
Loop
Application.ScreenUpdating = True '重新打开屏幕更新
Application.DisplayAlerts = True
MsgBox "汇总完成，共汇总了 " & m & "个文件" & Chr(10) & "用时：" & Format(Timer - ti, "000.00秒")
End Sub
5.打开汇总文件按“ALT F11”出现visual Basic for application的窗口，插入一个模块，把代码放在这
6.插入一个按钮，指定宏是“汇总指定文件指定工作表”
7.点击按钮出现一个选择文件夹的对话框，确定
8.出现一上请输入标题行数的对话框，输入你的要汇总的文件标题行数
9.几秒后汇总完成啦。
.
=====今天就学习到此======
