Aralıklı verileri aktarma

[Hakan ERDOST]

Sayfa 1 de bulunan verilerimi Sayfa 2ye aktarmak istiyorum ancak sayfa 1deki veriler 1500 satır.benim istediğim ise örneğin ilk verim d8 de ikinci verim bunun 44 satır altında ve bundan sonra 44 satır sürekli sabit.istediğim ise sayfa 1 d8 den başlayarak 44 atlayarak sayfa 2ye verileri aktarmak.

 

[İhsan Tank]

dosya ekleseniz daha iyi olur ( benim düşüncem )

 

[Hakan ERDOST]

dosya ekleseniz daha iyi olur ( benim düşüncem )

Dosya eklemek sorun değil de kişisel bilgiler var Tc falan..

 

[Mahir64]

Dosya eklemek sorun değil de kişisel bilgiler var Tc falan..

Merhaba
Dosyanızı farazi bilgilerle değiştirerek ekleyin

 

[Hakan ERDOST]

Dosya ve bazı açıklamalr ekte

 

[Hakan ERDOST]

Mümkün olmayan bir şey istedim herhalde...

 

[Huseyinkis]

Mümkün olmayan bir şey istedim herhalde...

Ekteki kod denermisiniz.

Sub Tablo()
Sheets("Sayfa2").Range("A2:G5000").Clear
Sheets("Sayfa1").Select
For I = 3 To Sheets("Sayfa1").[B65000].End(3).Row
If Sheets("Sayfa1").Range("B" & I).Value = "Okul No:" Then
ss = Sheets("Sayfa2").[A65000].End(3).Row + 1
 Sheets("Sayfa2").Select
    Cells(ss, 1).Value = Sheets("Sayfa1").Range("D" & I).Value
    Cells(ss, 2).Value = Sheets("Sayfa1").Range("D" & I + 2).Value
    Cells(ss, 3).Value = Sheets("Sayfa1").Range("D" & I + 4).Value
    Cells(ss, 4).Value = Sheets("Sayfa1").Range("D" & I + 6).Value
    Cells(ss, 5).Value = Sheets("Sayfa1").Range("D" & I + 8).Value
    Cells(ss, 6).Value = Sheets("Sayfa1").Range("D" & I + 10).Value
    Cells(ss, 7).Value = Sheets("Sayfa1").Range("D" & I + 14).Value
End If
Next
    MsgBox "AKTARIM GERÇEKLEŞTİ "
End Sub

 

[Hakan ERDOST]

Olmuyor kod hiçbir veri aktarmıyor.

 

[Huseyinkis]

Olmuyor kod hiçbir veri aktarmıyor.

Ekteki dosyayı incelermisiniz.

aktardığınız verilerde satırlar önemli bu dosyadaki gibi format olması lazım. orj dosyadada a sutunu boş b stunu açıklama d sutunu alınacak veriler olması gerekiyor.sayfa isimleride önemli

Kodlar gönderdiğiniz dosyada çalışıyor.

 

[Hakan ERDOST]

Öncelikle ilginize teşekkürler.Kod çalışıyor.Sorun benim kodu yanlış sayfada çlıştırmamdan kaynaklanıyormuş.Ancak bir sorunum daha doğrusu ilave bir iteğim daha var.Ben öğrenciye ait tüm verileri veritabanı şekline dönüştürmek istediğimden kodunuzda değişiklik yaptım ama olmadı.Dosya ekte yardımcı olursanız sevinirim.Kolay gelsin.

 

[Huseyinkis]

Öncelikle ilginize teşekkürler.Kod çalışıyor.Sorun benim kodu yanlış sayfada çlıştırmamdan kaynaklanıyormuş.Ancak bir sorunum daha doğrusu ilave bir iteğim daha var.Ben öğrenciye ait tüm verileri veritabanı şekline dönüştürmek istediğimden kodunuzda değişiklik yaptım ama olmadı.Dosya ekte yardımcı olursanız sevinirim.Kolay gelsin.

Ekteki kodları kullanıp denermisiniz.

Sub Tablo()
Sheets("Sayfa2").Range("A2:Q5000").Clear
Sheets("Sayfa1").Select
For I = 3 To Sheets("Sayfa1").[B65000].End(3).Row
If Sheets("Sayfa1").Range("B" & I).Value = "Okul No:" Then
ss = Sheets("Sayfa2").[A65000].End(3).Row + 1
 Sheets("Sayfa2").Select
    Cells(ss, 1).Value = Sheets("Sayfa1").Range("D" & I).Value
    Cells(ss, 2).Value = Sheets("Sayfa1").Range("D" & I + 2).Value
    Cells(ss, 3).Value = Sheets("Sayfa1").Range("D" & I + 4).Value
    Cells(ss, 4).Value = Sheets("Sayfa1").Range("D" & I + 6).Value
    Cells(ss, 5).Value = Sheets("Sayfa1").Range("D" & I + 8).Value
    Cells(ss, 6).Value = Sheets("Sayfa1").Range("D" & I + 10).Value
    Cells(ss, 7).Value = Sheets("Sayfa1").Range("D" & I + 14).Value
    Cells(ss, 8).Value = Sheets("Sayfa1").Range("D" & I + 16).Value
    Cells(ss, 9).Value = Sheets("Sayfa1").Range("D" & I + 18).Value
    Cells(ss, 10).Value = Sheets("Sayfa1").Range("D" & I + 20).Value
    Cells(ss, 11).Value = Sheets("Sayfa1").Range("D" & I + 22).Value
    Cells(ss, 12).Value = Sheets("Sayfa1").Range("D" & I + 26).Value
    Cells(ss, 13).Value = Sheets("Sayfa1").Range("D" & I + 28).Value
    Cells(ss, 14).Value = Sheets("Sayfa1").Range("D" & I + 30).Value
    Cells(ss, 15).Value = Sheets("Sayfa1").Range("D" & I + 32).Value
    Cells(ss, 16).Value = Sheets("Sayfa1").Range("D" & I + 35).Value
    Cells(ss, 17).Value = Sheets("Sayfa1").Range("D" & I + 37).Value
    Cells(ss, 18).Value = Sheets("Sayfa1").Range("L" & I + 14).Value
    Cells(ss, 19).Value = Sheets("Sayfa1").Range("L" & I + 16).Value
    Cells(ss, 20).Value = Sheets("Sayfa1").Range("L" & I + 18).Value
    Cells(ss, 21).Value = Sheets("Sayfa1").Range("L" & I + 20).Value
    Cells(ss, 22).Value = Sheets("Sayfa1").Range("L" & I + 22).Value
    Cells(ss, 23).Value = Sheets("Sayfa1").Range("L" & I + 26).Value
    Cells(ss, 24).Value = Sheets("Sayfa1").Range("L" & I + 28).Value
    Cells(ss, 25).Value = Sheets("Sayfa1").Range("L" & I + 30).Value
    Cells(ss, 26).Value = Sheets("Sayfa1").Range("L" & I + 32).Value
End If
Next
    MsgBox "AKTARIM GERÇEKLEŞTİ "
End Sub