Altalta Verileri secip yanyana yazma problemi

[Senegale]

Merhaba arkadaslar

Senegal'den sevgiler. Sizin icin kucuk ama benim icin buyuk bir sorunum var yardimci olabilecek biri cikarsa cok sevinirim.

Elimde bir excel tablosu var. Sadece A sutununda veriler var ve alt alta siralanmis durumda. Yaklasik 10-15 satirda bir tane veri kirmizi ile yazilmis
ornek kirmizi veri
veri
veri
veri
.
.
ornek kirmizi veri 2
veri
veri
.
.

Seklinde 15343 satirdan olusuyor.

Yapmak istedigim sey su; Her kirmizi veriden baslayarak altindaki 8 adet veriyle beraber kopyalayip yanyana yapistirmak

Umarim anlatabilmisimdir.
Not: Kirmizi satirlar belli bir sayi dongusunde degil. birinciyle ikinci arasinda 15 veri varken 2.ci ile 3.cu arasinda 17 tane var gibi.

Simdiden tesekkurler

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub renk()
For i = 1 To Cells(Rows.Count, "A").End(3).Row
yeni = 2
If Cells(i, "A").Font.Color = vbRed Then
    Range("A" & i & ":A" & i + 8).Select
    Selection.Copy
    Cells(yeni, "D").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    yeni = yeni + 1
End If
Next
End Sub

 

[Senegale]

Tesekkurler

Kod calisinca uzunca bir sure bekliyor. Sonuc olumlu ancak sadece en sondaki veriyi gorebiliyorum kaydedilmis olarak. Ustuste kaydediyor olabilir mi?

 

[YUSUF44]

yeni = 2 satırını for satırından önceye alın, küçük bir hata, kusura bakmayın

 

[Senegale]

Calisti ellerine saglik Cok tesekkurler