如何将符合条件的行从B列开始粘贴？VBA代码修改求助

现有VBA代码可将InventoryAvailability工作表中U列值为"X"的整行复制到CountSheet工作表的A列起始位置，但需求改为从B列开始粘贴。尝试将代码中Range("A" & Rows.Count)修改为Range("B" & Rows.Count)后无效果。

原代码如下：

Sub MoveRowBasedOnCellValueX()

    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("InventoryAvailability").UsedRange.Rows.Count
    J = Worksheets("CountSheet").UsedRange.Rows.Count
    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("CountSheet").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("InventoryAvailability").Range("U4:U" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "X" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("CountSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
    
End Sub

直接修改目标列地址无效的核心原因：代码中使用EntireRow.Copy复制整行内容，即便指定目标为B列单元格，Excel仍会将整行内容粘贴到目标单元格所在行的A列起始位置，覆盖整行，因此看起来没有从B列开始粘贴。

调整复制范围，不再复制整行，而是复制当前行中有数据的列区域，再粘贴到CountSheet的B列起始位置。修改代码中的复制粘贴逻辑行即可：

修改后的完整代码：

Sub MoveRowBasedOnCellValueX()

    Dim xRg As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    Dim targetSheet As Worksheet
    Dim sourceSheet As Worksheet
    
    Set sourceSheet = Worksheets("InventoryAvailability")
    Set targetSheet = Worksheets("CountSheet")
    
    I = sourceSheet.UsedRange.Rows.Count
    J = targetSheet.UsedRange.Rows.Count
    If J = 1 Then
        If Application.WorksheetFunction.CountA(targetSheet.UsedRange) = 0 Then J = 0
    End If
    Set xRg = sourceSheet.Range("U4:U" & I)
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "X" Then
            ' 复制当前行从A列到最后一个使用列的内容，粘贴到目标表B列的下一个空行
            sourceSheet.Cells(xRg(K).Row, 1).Resize(1, sourceSheet.UsedRange.Columns.Count).Copy _
                Destination:=targetSheet.Range("B" & targetSheet.Rows.Count).End(xlUp).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
    
End Sub

• 替换xRg(K).EntireRow.Copy为sourceSheet.Cells(xRg(K).Row, 1).Resize(1, sourceSheet.UsedRange.Columns.Count).Copy：仅复制当前行中有数据的列区域，而非整行。
• 目标地址明确指向targetSheet.Range("B" & targetSheet.Rows.Count).End(xlUp).Offset(1)：确保从B列的下一个空行开始粘贴。

内容的提问来源于stack exchange，提问作者cnutco