Deleting Blank Rows than Organize Data from A to Z

Hello,

Attached is a Macro I am writing that will look at Basketball Data.

On sheet 1 I wrote a code to find all the PGs (point guards) in the list and copy only the PGs to Sheet 2
this is code is in module 1

then in module 2
I attempt to erase all the blank rows... But i run into to the problem where there is one blank row remaining.

I want to write a third module that would organize the data from the Point Guard with the most points at the top down to the lowest scoring point guard.

Can anyone give me any insight on why that last row won't delete from module 2 or How I can write a macro that would organize the higher points & player from top to bottom?

Actually, I would need it for VBA not Pivot tables...
I am attempting to understanding the logic more or less through a Macro.

One macro to rule them all

Sub Filter_Data()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Sheet2")
Dim icell As Range

Application.ScreenUpdating = False

For Each icell In ws1.Range("C2:C" & ws1.Range("C" & Rows.Count).End(xlUp).Row)
    If icell.Value = "PG" Then
        Union(icell.Offset(0, -2), icell.Offset(0, 2)).Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next icell

ws2.Sort.SortFields.Clear
ws2.Sort.SortFields.Add Key:=Range("B2:B" & ws2.Range("B" & Rows.Count).End(xlUp).Row), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ws2.Sort
    .SetRange Range("A1:B" & ws2.Range("B" & Rows.Count).End(xlUp).Row)
    .Header = xlYes
    .Apply
End With

Application.ScreenUpdating = True

End Sub

PS. Send me a pm if you want to know what is going on in the macro. You seemed to indicate you wanted macro knowledge