Acil. Lütfen yardım ediniz istenen adette veriyi bir alt satıra yazmak

[KURBA]

..........

 

[Necdet]

Merhaba hemşehrim.

Aşağıdaki kodları deneyiniz.

Sub Grupla()
 
    Dim i       As Long, _
        j       As Integer, _
        k       As Integer, _
        n       As Long, _
        aKol    As String, _
        d(), _
        s
 
    Application.ScreenUpdating = False
 
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        s = Split(Trim(Cells(i, "A")), "-")
        aKol = ""
        k = 0
 
        For j = 0 To UBound(s)
            k = k + 1
            If Len(aKol) = 0 Then
                aKol = s(j)
            Else
                aKol = aKol & "-" & s(j)
            End If
 
            If k > 9 Then
                n = n + 1
                ReDim Preserve d(1 To 3, 1 To n)
                d(1, n) = aKol
                d(2, n) = Cells(i, "B")
                d(3, n) = Cells(i, "C")
                k = 0
                aKol = ""
            End If
        Next j
             If k > 0 Then
                n = n + 1
                ReDim Preserve d(1 To 3, 1 To n)
                d(1, n) = aKol
                d(2, n) = Cells(i, "B")
                d(3, n) = Cells(i, "C")
                k = 0
                aKol = 0
            End If
    Next i
 
    Range("E1").Resize(n, 3) = Application.WorksheetFunction.Transpose(d)
 
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlanmıştır..."
 
End Sub

Kod sonucu E1 hücresinden itibaren yazar. Siz kodların doğru çalıştığına emin olduğunda Range("E1").Resize ile başlayan satırda E1'i A1 yapabilirsiniz.

Not : Sorudaki konu başlığınızı bundan böyle "Acil", "Acil Yardım" vs gibi değil, doğrudan konuyu özetleyecek başlık olarak düzenleyiniz.

 

[KURBA]

teşekkürler.

Allah ne muradın varsa versin kardeş...

 

[Necdet]

Allah ne muradın varsa versin kardeş...

Goca rabbımızı her işimize karıştırmayalım