复制到其他工作表时单元格保持空白

Question

我正在将 Worksheet1 和 Worksheet2 中的数据复制到 Worksheet3 中。

代码遍历工作表 1 中的所需范围，找到一个 X 并将 X 右侧的第 9 行的值复制到工作表 3。然后它在 Worksheet2 上做同样的事情。

Dim WrkSht As Worksheet
Dim WrkShtCol As Sheets
Dim cl As range
Dim rw As range

Sub CopyFromSheetsToOtherSheet()

Set WrkShtCol = Worksheets(Array("Worksheet1", "Worksheet"))

For Each WrkSht In WrkShtCol

    For Each rw In WrkSht.range(Antwortrange).Rows   'Reihen durchlaufen innerhalb der Antwortrange
        For Each cl In rw.Cells
            If LCase(cl.Value) = "x" Then
                cl.Offset(0, 9).Copy Sheets("Worksheet3").range("A" & Rows.Count).End(xlUp).Offset(1)       'Jede Zelle mit Value "x" 9 Spalten nach rechts auswählen (Handlungsempfehlung), weitergeben
            End If
        Next cl
    Next rw

代码从单元格 A2 开始复制到 Worksheet3，然后是 A3、A4 等。
我希望它从 A1 开始。第一步为什么不复制到A1？

我稍后会使用函数来查找空白，因此我不能在单元格 A1 中有空白。

Answer 1

Sheets("Worksheet3").range("A" & Rows.Count).End(xlUp).Offset(1) 

如果第一个空白单元格是A1，那么由于Offset(1)，A1 将始终被跳过。

也许使用这样的辅助函数：

Private Function GetNextAvailableCell( _
   ByVal ws As Worksheet, _
   ByVal colNumber As Long _
) As Range

   With ws
      Dim tempRng As Range
      Set tempRng = .Cells(.Rows.Count, colNumber).End(xlUp)
   End With

   If Not IsEmpty(tempRng) Then
      Set tempRng = tempRng.Offset(1)
   End If

   Set GetNextAvailableCell = tempRng
End Function

然后像这样使用它：

cl.Offset(0, 9).Copy GetNextAvailableCell(Sheets("Worksheet3"), 1)

Answer 2

我确信有一种更简洁的方法可以做到这一点，但首先想到的是在最后一行计算中添加一些条件检查 (lr)

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Worksheet3")

'For Each cl...

    lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row
    If lr = 2 And ws.Range("A1") = "" Then lr = 1
    cl.Offset(0, 9).Copy ws.Range("A" & lr)

'Next cl...

---

当在这种情况下使用Offset(1) 时，您最终会得到lr = 2 两次。首先当该列为空白时，再次仅使用 A1 时。要解决您可以在lr = 2 时添加条件语句来确定要使用的范围