Question

当我尝试运行此循环时，我在Cell.Value.Copy行中收到Error：Object Required。我该怎么做才能解决这个错误？

Sub Findings()
Application.ScreenUpdating = False

Dim Cell As Object
Dim Rng As Range

Set Rng = Sheets("Sheet1").Range("C5:C74")
For Each Cell In Rng
  If (Cell.Value <> "") Then
    Cell.Value.Copy
  End If
Next Cell

If IsEmpty(Range("C85").Value) = True Then
  Range("C85").PasteSpecial xlPasteValues
ElseIf IsEmpty(Range("C86").Value) = True Then
  Range("C86").PasteSpecial xlPasteValues
ElseIf IsEmpty(Range("C87").Value) = True Then
  Range("C87").PasteSpecial xlPasteValues
End If

Application.ScreenUpdating = True
End Sub

Answer 1

如果您只想复制带有值的单元格（没有返回空值的公式），您可以使用SpecialCells(xlCellTypeConstants)来设置范围。

请参阅下面的代码：

Sub Findings()

Application.ScreenUpdating = False

Dim Rng As Range

With Sheets("Sheet1")
    ' set "Rng" only to cells inside the range with values inside them
    Set Rng = .Range("C5:C74").SpecialCells(xlCellTypeConstants)
    Rng.Copy

    If IsEmpty(.Range("C85").Value) Then
        .Range("C85").PasteSpecial xlPasteValues
    ElseIf IsEmpty(.Range("C86").Value) Then
        .Range("C86").PasteSpecial xlPasteValues
    ElseIf IsEmpty(.Range("C87").Value) Then
        .Range("C87").PasteSpecial xlPasteValues
    End If

End With    
Application.ScreenUpdating = True

End Sub

通过Loop-VBA复制单元

1 个答案: