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

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

我确定有更简洁的方法来执行此操作，但首先想到的是在最后一行计算中添加一些条件检查 (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 时添加一个条件语句来确定要使用的范围

Answer 2

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)

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

Cell Remains Blank When Copying to Other Worksheet

excel

vba

loops

worksheet

copying