I have been able to get everything to do what I need it to do, but when I
added the Do...Until Loop it gets hung up.

Here is what I have so far:

# Dim aRange As Range  
# Set aRange = ActiveCell  
#  
#  
# 'Do Until ActiveCell.Value = ""  
#     ActiveCell.Select  
#     Selection.Cut  
#     aRange.Offset([3], [-1]).Select  'When I add the Do Loop it gets stuck
here!  
#     ActiveSheet.Paste  
#     ActiveCell.Copy  
#      
#     aRange.Offset([0], [1]).Select  
#     Selection.End(xlDown).Offset([0], [-1]).Select  
#     ActiveSheet.Paste  
#     Application.CutCopyMode = False  
#     ActiveCell.Select  
#     Range(Selection, Selection.End(xlUp)).Select  
#     Selection.FillUp  
#     ActiveCell.Select  
#     Selection.End(xlDown).Select  
#     ActiveCell.Select  
#     Selection.Offset([4], [1]).Select  
# 'Loop  
#      
# End Sub  

Any suggestions??? Also, if any of this code can be cleaned up feel free to
offer ideas!

Thanks in advance