通过检查条件复制整行并粘贴到不同范围的单元格中

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)来定义复制范围； 它将继续以这种方式复制相同的数据。