excel vba实现将多个文件内容复制汇总到一个Excel文件中

在论坛上看到有网友问到如何把多个数据同时导出追加到同到Excel中。这里写了几个函数。复制到宏命令代码里面，执行宏即可实现。功能：遍历用户指定的文件夹，把文件夹中所有的excel文件的第一个表格的数据复制到本excel文件中。注意，每个excel文件中有效数据行的判断标准是A列的最后一个有数据的单元格的行号，比如A列到第10行结束，B列到第11行结束，那么程序将不会复制第11行。
效果图：

1505120719107403.gif

详细源码：Subcombine()
DimfolderAsString
DimcountAsInteger
folder=ChooseFolder()
count=combineFiles(folder,"xls")
'count=count+combineFiles(folder,"xlsx")
EndSub
'整合文件
FunctioncombineFiles(folder,appendix)
DimMyFileAsString
DimsAsString
Dimcount,n,copiedlinesAsInteger
MyFile=Dir(folder&"\*."&appendix)
count=count+1
n=2
DoWhileMyFile""
copiedlines=CopyFile(folder&"\"&MyFile,2,n)
Ifcopiedlines>0Then
n=n+copiedlines
count=count+1
EndIf
MyFile=Dir
Loop
combineFiles=count
EndFunction
'复制数据
FunctionCopyFile(filename,srcStartLine,dstStartLine)
DimbookAsWorkbook
DimsheetAsWorksheet
DimrcAsInteger
CopyFile=0
Iffilename=(ThisWorkbook.Path&"\"&ThisWorkbook.Name)Then
ExitFunction
EndIf
Setbook=Workbooks.Open(filename)
Setsheet=book.Sheets(1) '使用第一个sheet
rc=sheet.Range("A65536").End(xlUp).Row
Ifrc>=srcStartLineThen
sheet.Rows(srcStartLine&":"&rc).copyThisWorkbook.Sheets(1).Range("A"&dstStartLine) '复制到指定位置
CopyFile=rc-srcStartLine+1
EndIf
book.Close
EndFunction
'选择文件夹
FunctionChooseFolder()AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFolderPicker)
WithdlgOpen
If.Show=-1Then
ChooseFolder=.SelectedItems(1)
EndIf
EndWith
SetdlgOpen=Nothing
EndFunction
参考至：oceanking（博客园）