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

Question

背景知识：我正在尝试从 "Create Form" N2:AE14

复制 table

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 被复制后全部包含空白，我将尝试找出一种删除 "Sample Data" 中整行的方法。

我目前有一个循环来处理 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

假设

你想删除

"an entire Row in "Sample Data" if Columns K:R all contain blanks"

你可以试试这个：

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

Delete Row if Columns K:R all contain blanks VBA Excel

excel

vba

copy

paste

rowdeleting