Macro to copy rows containing specific blank cells to another workbook.

[petry_37]

Hi, I have spreadsheet of data, I need to extract any rows that have blanks cells in columns F or P or T.

If possilbe I would like a macro I could run that would cut all of the rows that meet the above criteria and paste them in to a seperate sheet.

Any help is much appreciated, please messageme if you require further information.

Thanks again!

 

[AlphaFrog]

G'day from up over. Try this...

[color=darkblue]Sub[/color] Blanks_colFPT()
    
    [color=darkblue]Dim[/color] cell [color=darkblue]As[/color] Range, rng [color=darkblue]As[/color] Range
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] Range("F1,P1,T1")
        [color=darkblue]If[/color] rng [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            [color=darkblue]Set[/color] rng = cell.EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow
        [color=darkblue]Else[/color]
            [color=darkblue]Set[/color] rng = Union(rng, cell.EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow)
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] rng [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        rng.Copy Destination:=Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1")
        rng.Delete
    [color=darkblue]Else[/color]
        MsgBox "No bank cells found in columns F, P, or T ", , "Rows Not Copied"
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[sky1in5]

Sub test()
Dim LastRowF, LastRowP, LastRowT As Long
Dim n As Long
LastRowF = Sheet1.Range("F" & Rows.Count).End(xlUp).Row
LastRowP = Sheet1.Range("P" & Rows.Count).End(xlUp).Row
LastRowT = Sheet1.Range("T" & Rows.Count).End(xlUp).Row
For i = 1 To LastRowF
n = 1
    If IsEmpty(Sheet1.Range("F" & i)) = True Then
    
        Sheet1.Rows(i).Copy
        Sheet2.Activate
        Range("A" & n).Select
        ActiveSheet.Paste
        
    End If
    
    If IsEmpty(Sheet1.Range("P" & i)) = True Then
    
        Sheet1.Rows(i).Copy
        Sheet3.Activate
        Range("A" & n).Select
        ActiveSheet.Paste
    End If
    
    If IsEmpty(Sheet1.Range("T" & i)) = True Then
    
        Sheet1.Rows(i).Copy
        Sheet4.Activate
        Range("A" & n).Select
        ActiveSheet.Paste
    End If
    
        n = n + 1
        
Next i
End Sub

make sure you got 4 sheet in total. sheet1 is the main sheet. please change the code accordingly to your sheet.