Sub Demo()
Dim lRow As Long, lCol As Long, i As Long, j As Long, SBar As Boolean
With Application
  SBar = .DisplayStatusBar
  .DisplayStatusBar = True
  .ScreenUpdating = False
  .Calculation = xlManual
End With
ThisWorkbook.Worksheets("Sheet1").UsedRange.Copy
ThisWorkbook.Worksheets("Sheet2").Paste Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")
With ThisWorkbook.Worksheets("Sheet2").UsedRange
  lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row - 1
  lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
  For i = lRow To 1 Step -1
    Application.StatusBar = "Processing row " & i
    If .Cells(i, lCol).Value = .Cells(i + 1, lCol).Value Then
      For j = 1 To lCol - 1
        If Len(Trim(.Cells(i, j).Value)) > 0 Then
          .Cells(i + 1, j).Value = .Cells(i, j).Text
          Exit For
        End If
      Next
      .Rows(i).EntireRow.Delete
    End If
  Next
End With
With Application
  .Calculation = xlAutomatic
  .StatusBar = False
  .DisplayStatusBar = SBar
  .ScreenUpdating = True
End With
End Sub