Tablonun üzerindeki verileri tablonun sonuna ekleme

[ziraatci26]

Arkadaşlar tabloların 5 satır üzerinde bulunan verileri tablonun her satırının sonuna ilave etmek istiyorum.Dosya ektedir.Yardımcı olursanız sevinirim.

 

[Recep İpek]

İsimler ile tabloların arasının boş olduğunu düşünerek aşağıdaki kodları hazırladım.

Umarım faydalı olur.

Sub BulYaz()
son = [a65536].End(3).Row
For i = 1 To son
If Cells(i, "a").Value = "A 1. Adi" Then
veri1 = Cells(i, "a").Value
veri2 = Cells(i, "b").Value
veri3 = Cells(i, "c").Value
veri4 = Cells(i, "d").Value
End If
If Cells(i, "a").Value <> "A 1. Adi" And Cells(i, "a").Value <> "" Then
Cells(i, "z").Value = veri1
Cells(i, "aa").Value = veri2
Cells(i, "ab").Value = veri3
Cells(i, "ac").Value = veri4
End If
Next i
MsgBox "Bitti"
End Sub

 

[ziraatci26]

hocam tablolar arası boş değil ama

 

[Recep İpek]

Peki bu aradaki verilerin A kolonunda, B1 ve sayı bulunuyor mu?Yoksa hepsi bunlardan başka veri mi?

 

[ziraatci26]

hocam A1 Adi ve A2 soyadı satırları ile tablo arasında ilgili ilgisiz sayı kelime herşey var.pdf den çevirdiğim bir veri.Sabit olan Adi ve soyadi nin başındaki kod numaraları ve A1 ile A2 hücrelerinin bulunduğu satırlar ile tablonun başlangıç satırının arasında 5 satır olması.find metodu ile denedim ama başaramadım.yardımcı olursanız çok memnun olurum.epeydir uğraşıyorum.Birde A1 Adi:Ahmet tek hücre içerisinde A1 Adi: bir hücre Ahmet bir hücrede değil aynı şekilde soyadida.dosya ektedir.yardımlarınız bekliyorum

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub BulYaz()
son = [a65536].End(3).Row
For i = 1 To son
If Left(Cells(i, "a").Value, 8) = [COLOR=blue]"A 1. Adi"[/COLOR] Then
veri1 = Mid(Cells(i, "a"), 10, Len(Cells(i, "a")) - 9)
veri2 = Mid(Cells(i, "h"), 12, Len(Cells(i, "h")) - 11)
    For j = 1 To 10 '[COLOR=red][B]10[/B][/COLOR] [COLOR=blue]Sayısını Maksimum Sıra Numarasına Göre Düzeltiniz.[/COLOR]
        Cells(6 + i, "z").Value = veri1
        Cells(6 + i, "aa").Value = veri2
            If Val(Cells(6 + i + j, "a").Value) = j Then
                Cells(6 + i + j, "z").Value = veri1
                Cells(6 + i + j, "aa").Value = veri2
            End If
    Next j
End If
Next i
MsgBox "Bitti"
End Sub