Question

我有一个文件列表：

它们共享一种通用格式，只有一个工作表，但可以有多行数据。打开它们，复制数据的所有单元格，然后粘贴到名为Addresses的工作表中。像这样：

然而，我得到的是：

现在我介入并注意到我的其他数据被放入目的地，它只是被覆盖（似乎是一个随机模式）。这是我使用的代码：

Option Explicit
Sub AddressListing()
  Dim Cell As Range
  With Worksheets("ghgh")
    For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
      If Len(Dir(Cell.Value)) Then
        With Workbooks.Open(Cell.Value)
          Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
              ThisWorkbook.Worksheets("Addresses").Cells(Rows.Count, "A").End(xlUp).Offset(1)
          .Close SaveChanges:=False
        End With
      Else
        MsgBox "File not found: " & Cell.Value
      End If
    Next Cell
  End With
'Call RemoveViaFilter
End Sub

为了解决这个问题而不是浪费每个人的时间，我创建了一个NextRow变量来查找工作簿中的下一个空白行。它仍然无法正常工作。我没有收到错误消息，数据只是以相同的方式输入。这是NextRow的代码：

Option Explicit
Sub AddressListing2()
  Dim Cell As Range
  Dim NextRow As Long
  NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
  With Worksheets("ghgh")
    For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
      If Len(Dir(Cell.Value)) Then
        With Workbooks.Open(Cell.Value)
          Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
              ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
          .Close SaveChanges:=False
        End With
      Else
        MsgBox "File not found: " & Cell.Value
      End If
    Next Cell
  End With
'Call RemoveViaFilter
End Sub

我从未遇到过NextRow的那种错误。我知道'找到下一个空白行并将数据放在那里'是一个常见问题，这就是为什么我认为NextRow会解决这个问题。但是，数据仍然被覆盖，我没有遇到任何解决此问题的问题。

我不想要定义的范围（例如A2：J100）并且有目的地避免它们，因为我的列表的长度不断变化。这适用于我想要粘贴的行和文件路径行。

非常感谢任何帮助，我之前几次使用'找空行'没有任何问题，并且不知道为什么它会覆盖数据。这似乎与找到空行的整个过程是对立的。

Answer 1

这是您放置额外行的地方......

   Option Explicit
    Sub AddressListing2()
      Dim Cell As Range
      Dim NextRow As Long
      NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
      With Worksheets("ghgh")
        For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
          If Len(Dir(Cell.Value)) Then
            With Workbooks.Open(Cell.Value)
              Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
                  ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
              .Close SaveChanges:=False
            End With
          Else
            MsgBox "File not found: " & Cell.Value
          End If
        'Add line here before going to new loop
        NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
        Next Cell
      End With
    'Call RemoveViaFilter
    End Sub

Answer 2

很明显，NextRow未正确计算。在计算之后输入一些验证码：

NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
While Application.WorksheetFunction.CountA(Rows(NextRow)) <> 0
    NextRow = NextRow + 1
Wend

这样可以确保NextRow为空行。

VBA：下一个空行随机覆盖某些行

2 个答案: