背景:我正在尝试从"Create“N2:a 14复制一个表
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.)或者帮我更快地删除行?
发布于 2017-03-05 10:09:05
假设
“示例数据”中的整行(如果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
https://stackoverflow.com/questions/42611226
复制相似问题