try
Sub a()
Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Worksheets(1).Range("A1")
Set rng2 = Worksheets(2).Range("A1")
Do Until rng1 = "" Or rng2 = ""
If rng1 < rng2 Then
Set rng1 = rng1.Offset(1)
ElseIf rng1 = rng2 Then
rng1.Offset(, 1) = rng2.Offset(, 1)
Set rng2 = rng2.Offset(1)
Else
rng1.EntireRow.Insert xlShiftDown
rng2.EntireRow.Copy rng1.Offset(-1).EntireRow
Set rng2 = rng2.Offset(1)
End If
Loop
MsgBox "done"
End Sub


regards


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=523042