Public Sub www()
    Dim r As Range, r1 As Range, a As Range, i&, j&, m&
    Sheets("Лист2").Cells.ClearContents
    With Sheets("Лист1")
        Set r = Intersect(.[a2].CurrentRegion.Offset(2), .Range("a:B"))
        Set r1 = Intersect(.[a2].CurrentRegion.Offset(2), .Range("c:c"))
        For i = 1 To r.SpecialCells(2).Areas.Count
            For m = 1 To r.SpecialCells(2).Areas(i).Rows.Count
                For j = 1 To r1.SpecialCells(2).Areas(i).Cells.Count
                    r.SpecialCells(2).Areas(i).Cells(m, 1).Resize(, 2).Copy Sheets("Лист2").[a65536].End(xlUp)(2)
                Next
                r1.SpecialCells(2).Areas(i).Copy Sheets("Лист2").[c65536].End(xlUp)(2)
            Next
        Next
    End With
End Sub