Sub ertert()
Dim x, y(), i&, k&, sm&
With Sheets("Данные")
    x = .Range("A6:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
With Application
    sm = .Sum(.Index(x, 0, 2))
End With
ReDim y(1 To sm, 1 To 1)

Do While sm > 0
    For i = 1 To UBound(x)
        If x(i, 2) > 0 Then
            k = k + 1
            y(k, 1) = x(i, 1)
            x(i, 2) = x(i, 2) - 1
            sm = sm - 1
        End If
    Next i
Loop

Sheets("Лист 1").Range("T1").Resize(UBound(y)).Value = y()
End Sub

Sub ertert()
Dim x, y(), i&, k&, sm&, lr&

With Sheets("Данные")
    With .Range("A6:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
        x = .Value
        For i = 1 To UBound(x)
            x(i, 3) = .Cells(i, 1).Interior.Color
        Next i
    End With
End With

With Application
    sm = .Sum(.Index(x, 0, 2))
End With
ReDim y(1 To sm, 1 To 1)

With Sheets("Лист 1")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    Do While sm > 0
        For i = 1 To UBound(x)
            If x(i, 2) > 0 Then
                k = k + 1
                If k > lr Then sm = 0: Exit For
                y(k, 1) = x(i, 1)
                x(i, 2) = x(i, 2) - 1
                sm = sm - 1
                .Cells(k, 20).Interior.Color = x(i, 3)
            End If
        Next i
    Loop
    .Range("T1").Resize(k).Value = y()
End With
End Sub