VB   发布时间:2022-04-03  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了用VB把多个excel文件的数据顺序拷到一个excel中大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。

是给朋友整理实验数据用的,两个小需求:

一、要第一列是数据序号,且多个文件数据拷到目的文件的时候数据序号要按顺序排列;

二、每个文件可能有多个worksheet,都要拷贝到目标文件里面。

对于office2003以前的excel,是支持Application.FileSearch的,实现代码如下:

Sub Test()

Dim i As Integer,iRow As Integer
Dim strPath As String
Dim TheSheet As Worksheet
iRow = 1
Set TheSheet = ActiveWorkbook.Worksheets("sheet1")
strPath = "D:/Macro/testtest"

With Application.FileSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
'Range("A" & i) = .FoundFiles(i)
Workbooks.Open (.FoundFiles(i))
For j = 1 To ActiveWorkbook.Worksheets.Count
'ActiveWorkbook.Worksheets(i).Cells(1,1).Value = "a"
ActiveWorkbook.Worksheets(j).UsedRange.Copy

TheSheet.Activate
While TheSheet.Range("a" & iRow).Value <> ""
TheSheet.Cells(iRow,1) = iRow
iRow = iRow + 1
Wend

TheSheet.Range("A" & iRow).SELEct
ActiveSheet.Paste
ActiveWorkbook.Save

Next j

Workbooks(Workbooks.Count).Close
Next i
End If
End With

End Sub

--------------------------------------------------------------------------------------

对于Office2007的用户,Application.FileSearch不支持了,修改后的代码如下:

Sub Test()

Dim i As Integer,iRow As Integer
Dim strPath,Filename,Search_Fullname As String
Dim TheSheet,CurrentSheet As Worksheet
Dim Coll_Docs As New Collection
Dim activeSheetName As String
iRow = 1
Set TheSheet = ActiveWorkbook.Worksheets("sheet1")
strPath = "D:/Macro/testtest"
Filename = "*.xls"
Set Coll_Docs = Nothing

DocName = Dir(strPath & "/" & FileName)

Do Until DocName = ""
Coll_Docs.Add Item:=DocName
DocName = Dir
Loop

For i = Coll_Docs.Count To 1 Step -1
Search_Fullname = strPath & "/" & Coll_Docs(i)
Workbooks.Open (Search_FullName)
For j = 1 To ActiveWorkbook.Worksheets.Count Step 1
If j = 1 Then
activeSheetName = "sheet" & j
Set CurrentSheet = ActiveWorkbook.Worksheets(activeSheetName)
End If
CurrentSheet.Activate
ActiveWorkbook.Worksheets(j).UsedRange.Copy
TheSheet.Activate
While TheSheet.Range("a" & iRow).Value <> ""
TheSheet.Cells(iRow,1) = iRow
iRow = iRow + 1
Wend

TheSheet.Range("A" & iRow).SELEct
ActiveSheet.Paste
ActiveWorkbook.Save

Next j

Workbooks(Workbooks.Count).Close
Next i

End Sub

大佬总结

以上是大佬教程为你收集整理的用VB把多个excel文件的数据顺序拷到一个excel中全部内容,希望文章能够帮你解决用VB把多个excel文件的数据顺序拷到一个excel中所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。