excel - 如果单元格范围已满，则复制

Question

如果范围的任何部分有值，我会尝试复制数据，否则什么也不做。

我认为当我设置变量时consulRng我没有正确执行它并且它不能确定它是否已满，它总是会复制。

Sub BlankLine()
    Dim Rng As Range
    Dim WorkRng As Range
    Dim consulRng As Range
    On Error Resume Next
    Set WorkRng = Range("A:E")
    Set consulRng = Worksheets("Hoja 2").Range("J2:O2")
    xLastRow = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    
    If IsEmpty(consulRng) Then
        GoTo EndSub
    Else:
        For xRowIndex = xLastRow To 1 Step -1
        Set Rng = WorkRng.Range("A" & xRowIndex)
            If Rng.Value = "Esto es una prueba" Then
                Sheets("Hoja 2").Range("H2:O2").Copy
                Rng.Offset(1, 0).Insert Shift:=xlDown
                Rng.Offset(1, 0).Paste
            End If
        Next
            
    End If
    
    Application.CutMode = False
    Application.ScreenUpdating = True
EndSub:
End Sub

更新代码：

Sub BlankLine()
    Dim Rng As Range
    Dim WorkRng As Range
    Dim consulRng As Range
    On Error Resume Next
    Set WorkRng = Range("A:E")
    Set consulRng = Worksheets("Hoja 2").Range("J2:O2")
    xLastRow = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    
    'If Not IsEmpty(consulRng) Then
    'If Application.CountA(consulRng) = 0 Then
    If Not Application.Count(consulRng) = 0 Then 'Contribution: PEH
        For xRowIndex = xLastRow To 1 Step -1
        Set Rng = WorkRng.Range("A" & xRowIndex)
            If Rng.Value = "Esto es una prueba" Then
                Sheets("Hoja 2").Range("H2:O2").Copy
                Rng.Offset(1, 0).Insert Shift:=xlDown
                Rng.Offset(1, 0).Paste
            End If
        Next
            
    End If
    
    Application.CutMode = False
    Application.ScreenUpdating = True
End Sub

霍加1：

霍亚2：

Hoja2数据完成：

Hoja1数据完成：

标签： excelvba

Answer 1

代替

If Not IsEmpty(consulRng) Then

只是

If Not Application.CountA(consulRng) = 0 Then