Developing.ru

Код: Выделить всё

Option Explicit

Sub AddData()
    Dim src As Worksheet, dst As Worksheet
    Dim i As Long, j As Long, b As Boolean
    
    Set src = ThisWorkbook.Worksheets(2)
    Set dst = ThisWorkbook.Worksheets(1)
    
    i = 2
    Do While Not src.Cells(i, 3).Value = Empty
        j = 2
        b = True
        Do While Not dst.Cells(j, 3).Value = Empty
            If src.Cells(i, 3).Value = dst.Cells(j, 3).Value Then
                b = False
                Exit Do
            End If
            j = j + 1
        Loop
        
        If b Then
            src.Range(src.Cells(i, 1), src.Cells(i, 4)).Copy
            dst.Cells(j, 1).PasteSpecial xlPasteAll
        End If
        
        i = i + 1
    Loop
End Sub