Place code in a Module. Run for active sheet. Be sure to run on a backup copy as usual when testing copy.
Code:
Sub MoveRowsUp()
Dim r As Range, r1 As Range, r2 As Range, v, i As Long
Set r = Range("A1", Range("A1").End(xlDown).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
Bookmarks