как написать макрос для такой задачи?????

[dzaymko]

пример внутри !

[EducatedFool]

вот так надо написать этот макрос:

Sub test()
    Dim cell As Range, ra As Range, cell2 As Range, destcell As Range
    Application.ScreenUpdating = False
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        For Each cell2 In ra.Offset(, 2).Cells
            If cell2 = cell.Next.Next Then
                Set destcell = Range("f" & Rows.Count).End(xlUp).Offset(1)
                destcell.Resize(, 2).Value = cell.Resize(, 2).Value
                destcell.Offset(, 2).Resize(, 2).Value = cell2.Offset(, -2).Resize(, 2).Value
            End If
        Next cell2
    Next cell
End Sub

пример внутри!
http://excelvba.ru/XL_Files/Sample__...__22-17-47.zip