通過檢查條件復制整行並粘貼到不同范圍的單元格中

Question

我正在使用下面的代碼通過檢查 B 列上的條件是主列還是備份，從范圍 A:D 復制 4 列數據直到該行的末尾。 如果主類別代碼將數據粘貼到 K:N 列，如果備份類別將整行粘貼到 P:S 列。

但是在執行時我收到對象定義錯誤。 任何人都可以幫助解決此代碼中的問題嗎？ 謝謝

Public Sub CopyData()


Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

Range("K2:S1400").Clear

Set rngQuantityCells = Range("B120", Range("B120").End(xlDown))

For Each rngSinglecell In rngQuantityCells

  If rngSinglecell.Value = "Primary" Then

    Range("K" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell.Value,   14).Value = _
        Range(Range("A" & rngSinglecell.Row), Range("D" & rngSinglecell.Row)).Value
  ElseIf rngSinglecell.Value = "Backup" Then

    Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell.Value, 19).Value = _
        Range(Range("A" & rngSinglecell.Row), Range("D" & rngSinglecell.Row)).Value
  End If
Next

End Sub

Answer 1

嘗試復制：

Public Sub CopyData()


Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

Range("K2:S1400").Clear

Set rngQuantityCells = Range("B120", Range("B120").End(xlDown))

For Each rngSinglecell In rngQuantityCells

  If rngSinglecell.Value = "Primary" Then

    Range(Range("A" & rngSinglecell.Row), Range("D" & rngSinglecell.Row)).Copy Range("K" & Rows.Count).End(xlUp).Offset(1)

  ElseIf rngSinglecell.Value = "Backup" Then

        Range(Range("A" & rngSinglecell.Row), Range("D" & rngSinglecell.Row)).Copy Range("P" & Rows.Count).End(xlUp).Offset(1)

  End If
Next

End Sub

無需調整大小。

Answer 2

嗯，除此之外，您正在以兩種完全不同的方式使用rngSingleCell.value ，其中之一不起作用。

rngSingleCell是包含Primary/Backup的單元格，對嗎？ 但是您試圖在需要數字值的resize方法中使用該值。 這肯定會讓你失望。

當然，如果沒有看到數據的實際布局，就很難確定，但不清楚為什么要使用Range().end(xlup).offset(1)來定義復制范圍； 它將繼續以這種方式復制相同的數據。