Sub delblankrows()

Dim s1 As Worksheet
Dim tmpR As Range
Dim rowcount As Long, colcount As Long, i As Long, j As Long, k As Boolean

'Change "Sheet1" to the name of your worksheet.
Set s1 = Sheets("sheet1")
Set tmpR = s1.UsedRange
rowcount = tmpR.Rows.Count
colcount = tmpR.Columns.Count

'Starts from bottom row and looks for non-empty cells from left to right.
'Moves to row above if non-empty cell is found.
'If none is found, then deletes row and shifts values up.
For i = rowcount To 1 Step -1
    k = 0
    For j = 1 To colcount
        If tmpR.Value2(i, j) <> "" Then
            k = 1
            Exit For
        End If
    Next j