ExcelVBA一键汇总多文件的指定工作表的到一个文件

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.几秒后汇总完成啦。

.

=====今天就学习到此======