To shift 5 columns to the upper row, if the upper row is empty

Try this:

Sub Remove_Blanks()
Dim ws As Worksheet:    Set ws = Sheets("SMOE-FRONT")
Dim collValues As Collection
Dim rCell As Range
Dim i As Integer, icolumn As Integer

Application.ScreenUpdating = False

For icolumn = 3 To 8
    If Application.WorksheetFunction.CountA(ws.Range(ws.Cells(23, icolumn), ws.Cells(52, icolumn))) > 1 Then
        Set collValues = New Collection
        For Each rCell In ws.Range(ws.Cells(23, icolumn), ws.Cells(52, icolumn)).SpecialCells(xlCellTypeConstants)
            collValues.Add rCell.Value
        Next rCell
        ws.Range(ws.Cells(23, icolumn), ws.Cells(52, icolumn)).ClearContents
        For i = 1 To collValues.Count
            ws.Cells(53, icolumn).End(xlUp).Offset(1, 0).Value = collValues.Item(i)
        Next i
        Set collValues = Nothing
    End If
Next icolumn

Application.ScreenUpdating = True

End Sub