您好,欢迎来到九壹网。
搜索
您的当前位置:首页VBA实现汇总excel,将多个Excel文件内容复制到一个Excel文件中

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

来源:九壹网


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

功能:遍历用户指定的文件夹,把文件夹中所有的excel文件的第一个表格的数据复制到本excel文件中。注意,每个excel文件中有效数据行的判断标准是A列的最后一个有数据的单元格的行号,比如A列到第10行结束,B列到第11行结束,那么程序将不会复制第11行。

说明:鄙人也不是大闲人,也就没有去迎合各种需求,只是根据自己的需要去写的,拿出来分享一下。

闲话少说,直接上代码,复制到宏命令代码里面,执行combine宏即可实现。

Sub combine()

Dim folder As String

Dim count As Integer

folder = ChooseFolder()

count = combineFiles(folder, \"xls\")

'count = count + combineFiles(folder, \"xlsx\")

End Sub

'整合文件

Function combineFiles(folder, appendix)

Dim MyFile As String

Dim s As String

Dim count, n, copiedlines As Integer

MyFile = Dir(folder & \"\\*.\" & appendix)

count = count + 1

n = 2

Do While MyFile <> \"\"

copiedlines = CopyFile(folder & \"\\\" & MyFile, 2, n)

If copiedlines > 0 Then

n = n + copiedlines

count = count + 1

End If

MyFile = Dir

Loop

combineFiles = count

End Function

'复制数据

Function CopyFile(filename, srcStartLine, dstStartLine)

Dim book As Workbook

Dim sheet As Worksheet

Dim rc As Integer

CopyFile = 0

If filename = (ThisWorkbook.Path & \"\\\" & ThisWorkbook.Name) Then

Exit Function

End If

Set book = Workbooks.Open(filename)

Set sheet = book.Sheets(1) '使用第一个sheet

rc = sheet.Range(\"A65536\").End(xlUp).Row

If rc >= srcStartLine Then

sheet.Rows(srcStartLine & \":\" & ThisWorkbook.Sheets(1).Range(\"A\" & dstStartLine) '复制到指定位置 CopyFile = rc - srcStartLine + 1

End If

book.Close

End Function

'选择文件夹

Function ChooseFolder() As String

rc).copy

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

If .Show = -1 Then

ChooseFolder = .SelectedItems(1)

End If

End With

Set dlgOpen = Nothing

End Function

因篇幅问题不能全部显示,请点此查看更多更全内容

Copyright © 2019- 91gzw.com 版权所有 湘ICP备2023023988号-2

违法及侵权请联系:TEL:199 18 7713 E-MAIL:2724546146@qq.com

本站由北京市万商天勤律师事务所王兴未律师提供法律服务