How to arrange cells like this?

[Kenneth Hobson]

Change that one line as Admin showed or this way. I did not catch that as I only tested using your example.

I did not see a problem with column F. I did not see a Dr in your example.

Attaching a short example file is one of the better ways to help us help you.

Sub MoveRowsUp()
  Dim r As Range, r1 As Range, r2 As Range, v, i As Long
  
  Set r = Range("A1", Cells(Rows.Count, "A").End(xlUp).Offset(1))
  
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  
  On Error GoTo EndSub
  For i = r.Rows.Count To 1 Step -1
    Set r1 = Cells(i, "A")
    Set r2 = Cells(i - 1, "A")
    If r1.Value = "" And r2.Value > 0 Then
      'Concatenate column B values
      v = r2.Offset(, 1).Value & r1.Offset(, 1).Value
      Range("B" & i & ":F" & i).Cut Destination:=Range("B" & i - 1 & ":F" & i)
      Rows(i).Delete Shift:=xlUp
      Cells(i - 1, "B").Value = v 'Add concatenated column B value back.
    End If
  Next i
  
EndSub:
  Application.EnableEvents = True
  Application.DisplayAlerts = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub