Copy certain range when a cell is not blank

Give this a go...

Option Explicit

Sub Copy()
Dim r As Long, lr As Long, rng As Range
With Sheet1.Cells(1).CurrentRegion
    .AutoFilter 16, "<>"
    r = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(12).Row
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Union(.Range("B" & r & ":C" & lr), .Range("P" & r & ":P" & lr))
    rng.Copy
    Sheet1.AutoFilterMode = False
    .Range("R4").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub

ell_
Your sheet layout is just made for AdvancedFilter.

Sub test()
    With Sheets("sheet1")
        .[v2].Formula = "=p2<>"""""
        .Cells(1).CurrentRegion.AdvancedFilter 2, .[v1:v2], .[extract]
        .[v2].Clear
    End With
End Sub

P.S.
You need to delete extra space at the end in P1 "Avg " to match with T3 "Avg".

what is meant by SpecialCells (12)

visible cells after filter

Hi, Sintek

Currently trying your code but it doesn't work as what I expected when I played with it. Here's my code:

Option Explicit

Sub Copy()
Dim r As Long, lr As Long, rng As Range
With ActiveWorkbook.Worksheets("Summary").Cells(1).CurrentRegion
    .AutoFilter 16, "<>"
    r = .Range("B9", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(12).Row
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    Set rng = Union(.Range("B" & r & ":C" & lr), .Range("AI" & r & ":AI" & lr))
    rng.Copy
    Worksheets("Summary").AutoFilterMode = False
    .Range("AL33").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

The blank data in column AI are still copied to AL33. May I know why?

Capture.PNG

To Jindon, thank you so much for this! I might be able to use it to my other sheets.

.AutoFilter 16, "<>"

The 16 above is for column P, You are now using Column AI which is Col # 35

Upload a sample of your new setup...

Upload a sample...Can't say until I see...

The top rows (1-8) have some other data

Quite important to know which columns this data occupies...Otherwise this snippet of code won't work

.Cells(1).CurrentRegion

Edit....
Not to worry...This workaround...

Option Explicit

Sub Copy()
Dim r As Long, lr As Long, rng As Range
With Sheet1
    With .Range("B9:AI" & Cells(Rows.Count, "B").End(xlUp).Row)
        .AutoFilter 34, "<>"
    End With
    r = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(12).Row
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    Set rng = Union(.Range("B" & r & ":C" & lr), .Range("AI" & r & ":AI" & lr))
    rng.Copy
    .AutoFilterMode = False
    .Range("AL33").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub

Do you now see how important actual worksheet setup is in order for us to assist...All 3 your uploads are different and hence the code has to be adapted to suite...

Option Explicit

Sub Copy()
Dim r As Long, lr As Long, rng As Range
Application.ScreenUpdating = False
With Sheet1
    With .Range("B8:AI" & Cells(Rows.Count, "B").End(xlUp).Row)
        .AutoFilter 34, "<>"
    End With
    r = .Range("B9", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(12).Row
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    Set rng = Union(.Range("B" & r & ":C" & lr), .Range("AI" & r & ":AI" & lr))
    rng.Copy
    .AutoFilterMode = False
    .Range("AL33").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Yep, filtering is always better than looping...See change in code Post #15 - red part - to speed up.

Set rng = .Range("B" & r & ":AI" & lr)

Copy code remains the same...

Glad I could help. Thanks for rep +