Question

背景：我正在尝试从“创建表单”N2：AE14

复制表格

Set r = Sheets("Create Form").Range("COPYTABLEB")
Selection.Copy

Set dest = Sheets("Sample Data").Range("B1").End(xlDown).Offset(1, 0)     
r.Copy
dest.PasteSpecial Paste:=xlPasteValues

我希望它只复制具有值而不是空白的单元格，但不幸的是它正在拾取公式并将它们粘贴为空白。因此，当我将下一部分粘贴到其中时，它会将空白视为数据。

所以我试图找出一种方法来删除“示例数据”中的整个行，如果列K：R一旦包含空白就包含空白。

我目前有一个循环来处理B列为空白，但这需要太长时间。

Lastrow = Range("B" & Rows.Count).End(xlUp).Row
MsgBox (Lastrow)
For i = Lastrow To 2 Step -1
If Trim(Range("B" & i).Value) = "" And Trim(Range("B" & i).Value) = "" Then
Range("B" & i).EntireRow.Select
Selection.Delete

End If

Next i

有人可以帮助我吗：
a。）复制并粘贴所有空白的值 b。）或帮我快速删除行？

Answer 1

假设

您要删除

＆＃34;整个行＆＃34;样本数据＆＃34;如果列K：R都包含空格＆＃34;

你可以试试这个：

Sub CopyValuesAndDeleteRowsWithBlankKRColumns()
    Dim pasteArea As Range
    Dim iRow As Long

    With Sheets("Create Form").Range("COPYTABLEB")
        Set pasteArea = Sheets("Sample Data").Range("B" & Rows.count).End(xlUp).Offset(1, 0).Resize(.Rows.count, .Columns.count)
        pasteArea.Value = .Value
    End With
    With Intersect(pasteArea, Sheets("Sample Data").Range("K:R"))
        For iRow = .Rows.count To 1 Step -1
            MsgBox WorksheetFunction.CountBlank(.Rows(iRow)) & " - " & WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8
            If WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8 = 0 Then .Rows(iRow).EntireRow.Delete
        Next
    End With
End Sub

如果列K：R全部包含空白VBA Excel，则删除行

1 个答案: