Question

我正在尝试使用VBA宏实现以下功能：

我有多个.xls文件，所有这些文件只有一张
在我的宏中，我希望将其他文件中的所有数据附加到一个工作表中，方法是将它们附加在文档的底部。我已经找到了迭代文件，但复制和附加数据就是困扰我的。

我到目前为止的代码如下（注释中描述了缺少的部分）

Sub Iterate_Files()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object

FromPath = ActiveWorkbook.Path
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)

For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files
    'Copy the data from sheet one of the FileInFolder
    'to the end of sheet in this file :/
    Next FileInFolder
Next objSubFolder

End Sub

Answer 1

以下代码似乎解决了问题：

Sub Iterate_Files()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object

FromPath = ActiveWorkbook.Path
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)
Set TargetWb = ActiveWorkbook

R = 0
For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files
        Set wbSource = Workbooks.Open(FileInFolder)
        wbSource.Worksheets(1).UsedRange.Copy Destination:=TargetWb.Worksheets(2).Cells(R + 1, 1)
        R = R + 15
        wbSource.Close SaveChanges:=False
    Next FileInFolder
Next objSubFolder

End Sub

Private Sub Rokaj_Click()
    Iterate_Files
End Sub

使用VBA将多个xls文件中的数据附加到一个文件中

1 个答案: