如果范围的任何部分有值,我会尝试复制数据,否则什么也不做。
我认为当我设置变量 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数据完成:
最佳答案
代替
If Not IsEmpty(consulRng) Then
只是If Not Application.CountA(consulRng) = 0 Then
关于excel - 如果单元格范围已满,则复制,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/68753064/