参考一下这个
稍微修改一下就可以用了
注意看注释
你建立一个表格
然后放一个command按钮
命名CommandButton1
在表格的文件夹里建立一个文件夹叫
"快速汇总多个工作簿"
在这个表格里放几个Excel文件
然后点这个按钮看看效果
老大我真的佩服死你了
比方说你在"C:/"下建立一个Excel
你就双击"我的电脑",双击"c盘"
点击鼠标右键,在弹出的菜单中选择新建
然后选择文件夹
然后重新命名就可以了
我要死了
所以说你要稍微改动一下
这个是以前的东西
我懒得改了!
稍微改一下就可以符合你的要求了
自己看一下~
看过一边 以后你自己要做什么的时候也有点影响
直接拿来用的话以后都不知道怎么修改
没进步的
Private Sub CommandButton1_Click()
Dim TempLen As Byte
Dim TempCount As Integer
Dim strTempPath As String, ViceName As String
Dim fFile As FileSearch
Dim TempMsgBox As VbMsgBoxResult
Set fFile = Application.FileSearch
With fFile
.LookIn = ThisWorkbook.Path & "\快速汇总多个工作簿" '设置文件路径
.Filename = "*.xls" '文件名称
If .Execute > 0 Then
TempMsgBox = MsgBox("共有" & .FoundFiles.Count & "个文件将被汇总", vbOKCancel, "记数")
If (TempMsgBox = vbCancel) Then
End
End If
TempCount = 1
Do
strTempPath = .FoundFiles(TempCount)
Debug.Print strTempPath
TempLen = Len(strTempPath)
ViceName = Mid(strTempPath, Len(fFile.LookIn) + 2, TempLen - Len(fFile.LookIn) - 1)
Workbooks.Open strTempPath
Workbooks(ViceName).Sheets("Sheet1").Activate
For i = 2 To 65535
If Workbooks(ViceName).Sheets("Sheet1").Cells(i + 1, 1) = "" Then
Exit For
End If
Next i
Workbooks(ViceName).Sheets("Sheet1").Range("A2:I" & i).Copy
Workbooks("快速汇总多个工作簿.xls").Sheets("Sheet1").Activate
Cells(Range("A2").Offset(TempCount + i - 1, 0).Row, 1).Select
Selection.PasteSpecial Paste:=xlValues
Workbooks(ViceName).Close
TempCount = TempCount + 1
Loop Until TempCount > .FoundFiles.Count
Else
TempMsgBox = MsgBox("目标路径下没有需要汇总的Excel文件", vbOKOnly, "提示")
End If
End With
End Sub
温馨提示:答案为网友推荐,仅供参考