Satırdaki verileri tek satıra indirgeme

[alper2323]

Merhaba;

Elimde ekli dosyadaki ürün kodları var. Bazı satırlarda birden fazla ürün kodu var ve ben fazla olan ürün kodlarını kopyalayıp yine A sütununun daki ürün kodlarının altına devam ederek eklemek istiyorum ve bunun otomatik olarak nasıl yapılacağı konusunda sizden destek rica ederiyorum. Tex to columns ile bölüp yan satıra almak işimi görmüyor. konuyu ayrıca dosya da belirttim.

Teşekkürler

 

[Orion1]

Buyurun.

Sub satir59()
Dim a, i As Long, sonsat As Long, sat As Long
Dim k As Integer
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
sat = sonsat + 1
For i = 2 To sonsat
    a = Split(Cells(i, "A").Value, ",")
    If UBound(a) > 0 Then
        Cells(i, "A").Value = CStr(a(0))
        For k = 1 To UBound(a)
            Cells(sat, "A").Value = CStr(a(k))
            sat = sat + 1
        Next k
    End If
Next i
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[alper2323]

çok teşekkürler, süper olmuş.

 

[Orion1]

çok teşekkürler, süper olmuş.

Rica ederim.
İyi çalışmalar.