Sub Macros1()
    my_sheets = "1"
    I = 1
    N = 1
    val_old = ""
    While Sheets(my_sheets).Cells(N, 20).Value <> ""
        Sheets(my_sheets).Cells(N, 20).Value = ""
        Sheets(my_sheets).Cells(N, 21).Value = ""
        N = N + 1
    Wend
    N = 1
    While Sheets(my_sheets).Cells(I, 1).Value <> ""
        If val_old = "" Or val_old = Sheets(my_sheets).Cells(I, 1).Value Then
            If Sheets(my_sheets).Cells(N, 21).Value <> "" Then
                Sheets(my_sheets).Cells(N, 21).Value = CStr(Sheets(my_sheets).Cells(N, 21).Value) + "," + CStr(Sheets(my_sheets).Cells(I, 2).Value)
            Else
                Sheets(my_sheets).Cells(N, 20).Value = Sheets(my_sheets).Cells(I, 1).Value
                Sheets(my_sheets).Cells(N, 21).Value = Sheets(my_sheets).Cells(I, 2).Value
            End If
        Else
            N = N + 1
            Sheets(my_sheets).Cells(N, 20).Value = Sheets(my_sheets).Cells(I, 1).Value
            Sheets(my_sheets).Cells(N, 21).Value = Sheets(my_sheets).Cells(I, 2).Value
        End If
        val_old = Sheets(my_sheets).Cells(I, 1).Value
        I = I + 1
    Wend
End Sub

Option Explicit

Public Sub CombineSizesPerArticle()

'замена запятых на точки'

[D:D].Replace ",", "."
[I:I].Replace ",", "."

Dim sh As Worksheet
Dim sArtCol As String
Dim sSizeCol As String
Dim sDestCol As String
Dim arts() As Variant
Dim sizes() As Variant
Dim i As Long
Dim dict As Object
Dim sArr() As String

sArtCol = "J"
sSizeCol = "I"
sDestCol = "W"

Set sh = ThisWorkbook.Sheets(1)
Set dict = CreateObject("Scripting.Dictionary")

arts = sh.Range(GetRangeToLastRow(sh, sArtCol))
sizes = sh.Range(GetRangeToLastRow(sh, sSizeCol))

For i = 1 To UBound(arts, 1)
    dict(arts(i, 1)) = dict(arts(i, 1)) & IIf(dict(arts(i, 1)) <> "", ", ", "") & sizes(i, 1)
Next

ReDim sArr(UBound(arts, 1))
For i = 1 To UBound(arts, 1)
    sArr(i - 1) = dict(arts(i, 1))
Next

sh.Range(sDestCol & ":" & sDestCol).Clear
sh.Range(sDestCol & "1").Resize(UBound(sArr), 1).Value = Application.Transpose(sArr)

'перенос столбца W в I'

Columns("W:W").Select
Selection.Cut
Columns("I:I").Select
ActiveSheet.Paste
    
'Удаление дубликатов'

    Dim lngI As Long
For lngI = Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
If Cells(lngI, 11).Value = Cells(lngI - 1, 11).Value Then
Rows(lngI).Delete Shift:=xlUp
End If
Next lngI

End Sub

Private Function GetRangeToLastRow(sh As Worksheet, sC As String) As String

Dim r As Long

r = sh.Cells(sh.Rows.Count, sh.Range(sC & ":" & sC).Column).End(xlUp).Row
GetRangeToLastRow = sC & "1:" & sC & r
End Function