İşaretlenmiş isimleri numaralarıyla birlikte aktarma

[hakki83]

Merhabalar
Küçük bir örnek oluşturdum. A sütununda isimler ve numaraları var. Bazı isimlerin numaraları birden fazla olabiliyor

Bu isimlerin bazılarının karşısına 1 rakamı koyarak işaretledim.

Almak istediğim sonuç, işaretlediğim isimleri kendine ait numaralarla birlikte almak. İsimlerin altındaki numaralar, o isme ait numaralardır


istediğim sonuç
D,E,F,G,H … gibi de olur.
K sütunundaki gibi de olur.
ikisi de işimi görür, hangisi kolayınıza gelirse.

Teşekkürler.

 

[sbayyigit]

Profesyonel değil ama işini görecektir.

Sub deneme()
Set s1 = Sheets("sayfa1")
b = 2
For a = 2 To 25

If s1.Range("b" & a) = 1 Then
s1.Range("s" & b).Value = s1.Range("a" & a)
a = a + 1
b = b + 1
If Application.IsNumber(s1.Range("a" & a)) Then
For c = a To 25
If Application.IsNumber(s1.Range("a" & c)) Then
s1.Range("r1") = "Sayısal"
s1.Range("s" & b).Value = s1.Range("a" & c)
b = b + 1
Else
GoTo 20
End If
Next
End If
20
End If
Next a
End Sub

 

[hakki83]

Çok teşekkür ederim. Emeğinize sağlık.