Skip rows with blank cell in particular column - vba

Question

Please advise me how to change my code to select rows only if they have a value in BC column (ignore complete row if cell in BC column is blank):
Private Sub CommandButton3_Click()
Range("A:a,b:b,c:c,e:e,bc:bc").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
End Sub

Answer 1

First run your code as is. Then perform the row deletions in the added workbook:
Sub dural()
Dim N As Long, I As Long, r As Range
N = Cells(Rows.Count, "BC").End(xlUp).Row
For I = N To 1 Step -1
Set r = Cells(I, "BC")
If IsEmpty(r) Then
r.EntireRow.Delete
End If
Next
End Sub

Answer 2

You could do this by using a filter:
Filter on column BC by unchecking (Blanks)
Copy the columns
Paste into a new worksheet or workbook
If it has to be VBA, here are two codes that will perform as desired.
This first code uses the autofilter:
Private Sub CommandButton3_Click()
Dim wsData As Worksheet
Dim wsNew As Worksheet
Set wsData = ActiveSheet
Set wsNew = Sheets.Add
With Intersect(wsData.UsedRange, wsData.Columns("BC"))
.Parent.AutoFilterMode = False
.AutoFilter 1, "<>"
Intersect(.SpecialCells(xlCellTypeVisible).EntireRow, wsData.Range("A:A,B:B,C:C,E:E,BC:BC")).Copy
wsNew.Range("A1").PasteSpecial xlPasteValues
wsNew.Range("A1").PasteSpecial xlPasteFormats
.AutoFilter
End With
wsNew.Move
Set wsData = Nothing
Set wsNew = Nothing
End Sub
This second, alternative code uses a find loop:
Private Sub CommandButton3_Click()
Dim rngFound As Range
Dim rngCopy As Range
Dim strFirst As String
Set rngFound = Columns("BC").Find("*", Cells(Rows.Count, "BC"), xlValues, xlWhole)
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Set rngCopy = rngFound
Do
Set rngCopy = Union(rngCopy, rngFound)
Set rngFound = Columns("BC").Find("*", rngFound, xlValues, xlWhole)
Loop While rngFound.Address <> strFirst
End If
If Not rngCopy Is Nothing Then
Sheets.Add
Intersect(rngCopy.Parent.Range("A:A,B:B,C:C,E:E,BC:BC"), rngCopy.EntireRow).Copy
Range("A1").PasteSpecial xlPasteValues
Range("A1").PasteSpecial xlPasteFormats
ActiveSheet.Move
End If
Set rngFound = Nothing
Set rngCopy = Nothing
End Sub