Sub dobav()
Dim result1()
Dim result2()
ReDim result1(1)
ReDim result2(1)
    For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        arr = Range(Cells(r, 1), Cells(r, Columns.Count).End(xlToLeft)).Value
            For i = 2 To UBound(Application.Transpose(arr))
                n = n + 1
                result1(n) = Cells(r, 1).Value
                result2(n) = arr(1, i)
                ReDim Preserve result1(UBound(result1) + 1)
                ReDim Preserve result2(UBound(result2) + 1)
            Next i
    Next
    Cells(4, 12).Resize(UBound(result1), 1) = Application.Transpose(result1)
    Cells(4, 13).Resize(UBound(result2), 1) = Application.Transpose(result2)
End Sub