Удалить строку, если все столбцы K:R содержат пробелы VBA Excel

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

Может кто-нибудь, пожалуйста, помогите мне:
а) скопировать и вставить значения через минус все пробелы
б.) или помочь мне с более быстрым способом удаления строк?

Answer 1

При условии,

• вы хотите удалить

"целая строка в" Образце данных ", если все столбцы K:R содержат пробелы"

Вы можете попробовать это:

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