Sub Main()
    Dim MyRange As Range
    
    Set MyRange = ActiveWindow.RangeSelection
    Test MyRange
End Sub

Sub Test(MyRange As Range)
    Dim Cell1 As Range, Cell2 As Range, Cell3 As Range
    
    For Count =  1  To MyRange.Rows.Count
        Set Cell1 = MyRange.Cells(Count,  1 )
        Set Cell2 = MyRange.Cells(Count,  2 )
        ' если пустая ячейка в первом столбце
        If IsEmpty(Cell1.Value) Then GoTo Continue
        ' если не пустая ячейка во втором столбце
        If Not IsEmpty(Cell2.Value) Then GoTo Continue
        
        For Count2 = Count +  1  To MyRange.Rows.Count
            Set Cell3 = MyRange.Cells(Count2,  2 )
            If Not IsEmpty(Cell3.Value) Then
                Cell2.Value = Cell3.Value
                Cell3.Value = Empty
                Exit For
            End If
        Next
Continue:
    Next
End Sub

Sub Main()
    Dim MyRange As Range
    
    Set MyRange = ActiveWindow.RangeSelection
    Test MyRange
End Sub

Sub Test(MyRange As Range)
    Dim Cell1 As Range, Cell2 As Range, Cell3 As Range
    
    For Count =  1  To MyRange.Rows.Count
        Set Cell1 = MyRange.Cells(Count,  1 )
        Set Cell2 = MyRange.Cells(Count,  2 )
        ' если пустая ячейка в первом столбце
        If IsEmpty(Cell1.Value) Then GoTo Continue
        ' если не пустая ячейка во втором столбце
        If Not IsEmpty(Cell2.Value) Then GoTo Continue
        
        For Count2 = Count +  1  To MyRange.Rows.Count
            Set Cell3 = MyRange.Cells(Count2,  2 )
            If Not IsEmpty(Cell3.Value) Then
                Cell2.Value = Cell3.Value
                Cell3.Value = Empty
                Exit For
            End If
        Next
Continue:
    Next
End Sub