Question

下面的代码可以很好地将数据从一个工作簿复制到我的主服务器（Source.xlsx）。我是否可以修改此代码以对许多工作簿执行相同操作？我需要使用源中的列标题将一个目录中的许多文件中的数据附加到该表。我正在复制的文件总是有我正在寻找的标题，但在不同的列中。保存复制数据的文件名以及保存在添加列中的子文件夹和子文件夹2（主文件位置＆gt;子文件夹＆gt;子文件夹2＆gt;文件要复制）将非常有用。你能帮我StackOverflow大师吗？

Sub CopyByHeader()

    Dim CurrentWS As Worksheet
    Set CurrentWS = ActiveSheet

    Dim SourceWS As Worksheet
    Set SourceWS = Workbooks("vavc1.valor.carnival.com_2017-10-30.xls").Worksheets(1)
    Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
    Dim SourceCell As Range

    Dim TargetWS As Worksheet
    Set TargetWS = Workbooks("Source.xlsx").Worksheets(1)
    Dim TargetHeader As Range
    Set TargetHeader = TargetWS.Range("A1:K1")

    Dim RealLastRow As Long
    Dim SourceCol As Integer

    SourceWS.Activate
    For Each Cell In TargetHeader
        If Cell.Value <> "" Then
            Set SourceCell = Rows(SourceHeaderRow).Find _
                (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                SourceCol = SourceCell.Column
                RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If RealLastRow > SourceHeaderRow Then
                    Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
                        SourceCol)).Copy
                    TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
                End If
            End If
        End If
    Next

    CurrentWS.Activate

End Sub

Answer 1

所以你需要包装在循环中工作的代码。对于folder.files中的每个工作簿，运行您的代码。

这篇文章将告诉你如何迭代文件夹中的工作簿：

Loop through files in a folder using VBA?

使用列标题将数据从许多工作簿复制到主数据库

1 个答案: