Question

我正在尝试在Excel中使用vba来自动循环一组文件，以将其数据粘贴到主电子表格中。我认为我的代码几乎是正确的 - 但是有一个大问题。文件循环和数据副本，但每次粘贴另一组数据时，它会覆盖以前粘贴的数据。我需要来自所有循环文件的数据一个接一个地填充到主服务器上，而不是一个替换另一个。我已经粘贴了我正在使用的代码。在此先感谢您的帮助！

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "zOctober Master.xlsm" Then
            Exit Sub
        End If

        Workbooks.Open (Filepath & MyFile)
        Rows("21:100").Copy
        ActiveWorkbook.Close

        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))


        MyFile = Dir

    Loop

End Sub

Answer 1

使用您想要的单元格作为目标的左上角。

  erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
  Sheet1.Paste Destination:=Sheet1.Cells(erow, 1)

使用工作表.Name property或工作表.CodeName property。混合和匹配只会在他们变得“不同意”时导致麻烦。换句话说，如果要求从代号为Sheet1的工作表中粘贴下一行，则使用工作表代号Sheet1来标识粘贴的目标。您的代码中没有任何内容可以保证ActiveSheet property是Sheet1代号标识的工作表，也不保证任何一个工作表都带有名为Sheet1的工作表。

Answer 2

无需选择或激活范围。最好直接使用Range。

打开外部工作簿，然后将范围复制到原始工作簿。

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim xlMyWorkBook As Workbook
    Dim Filepath As String
    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "zOctober Master.xlsm" Then
            Exit Sub
        End If
     
        Set xlMyWorkBook = Workbooks.Open(Filepath & MyFile)
        
        xlMyWorkBook.ActiveSheet.Rows("21:100").Copy Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
        
        xlMyWorkBook.Close
        MyFile = Dir
    Loop

End Sub

<强>更新
已更改

xlMyWorkBook.Rows

要

xlMyWorkBook.ActiveSheet.Rows

用于调试

Sub LoopThroughDirectory() Const bDebugging As Boolean = True Dim MyFile As String Dim erow Dim wbSource As Workbook, wbTarget As Range Dim Filepath As String Dim lastRow As Long Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\" MyFile = Dir(Filepath) Do While Len(MyFile) > 0 If MyFile = "zOctober Master.xlsm" Then Exit Sub lastRow = Sheet1.Cells(rows.Count, 1).End(xlUp).Row + 2 Set wbTarget = Sheet1.Cells(lastRow, 1) Set wbSource = Application.Workbooks.Open(Filepath & MyFile) If bDebugging Then wbSource.ActiveSheet.rows("21:100").Select MsgBox "This is the Source Range", vbInformation Sheet1.Activate MsgBox "This is the Destination Range", vbInformation Else wbSource.ActiveSheet.rows("21:100").Copy wbTarget End If wbSource.Close False MyFile = Dir Loop End Sub

Answer 3

因为你的“固定” rangetocopy 地址（总是Rows("21:100")），如果你还可以修复最大列数（比如100），你就可以避免打开/关闭的负担和麻烦工作簿，就像下面这样：

Option Explicit

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim Filepath As String
    Dim iFile As Long

    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile <> "zOctober Master.xlsm" Then
            iFile = iFile + 1
            With ActiveSheet.Range("A1:A80").Resize(,100).Offset((iFile - 1) * 80)
                .Formula = "='" & Filepath & "[" & MyFile & "]Sheet1'!A21"
                .value = .value
            End With
        End If
        MyFile = Dir
    Loop
End Sub

实际上，即使您不能从源表中假设“固定”的最大列数，也可以采取相似的行动。

但对于初学者来说，让我们像上面一样开始

Answer 4

我相信您遇到的问题是由End(xlUp)电话引起的。你写它的方式（从最后一个占用的行开始），它将总是返回到第一个单元格，因此覆盖。如果删除此调用（保持2行偏移），则子应该按照需要运行。

一般情况下，最好避免完全使用End()，因为它的功能会根据遇到的单元格而有所不同（例如，如果在合并的单元格中调用End(xlToLeft)，它将转到合并范围内的第一个单元格，无论之前的单元格是否被占用和连续）

将文件循环到主工作表上，但数据会自动覆盖自己

4 个答案:

打开外部工作簿，然后将范围复制到原始工作簿。

用于调试