Atlayarak Seçim Yaptırma

[YusufTure]

Bir excel tablosunda...aynı aralıklarla giden bir veriyi başka bir yere yazdırmak istediğimizde nasıl bir yol izlememiz gerekir..

şöyle açıklayım
sayfa1 de 6 hane aralıklı standart şekilde giden bir tablo var..
bunu sayfa 2 ye yazdırmak istiyorum..,

yani kodun açıklaması şu şekilde oalcak tahminimce:

üstteki veriden(üstteki hane de 6 hane önceki veri oluyor ) 6 hane yatay sonrasına git ve gördüğün veriyi buraya yaz
yada dikey farketmez

ama şu an benim işime yatay yarıyor


Resim;

 

[Orion1]

Hangi sütundaki veri de 6 hane sonrası yazılacak.Yoksa 6 hane dediğiniz 6 sütunmu.Eğer öyleyse sütun başlangıcı neresidir.
Gördüğünüz gibi açıklamanız yeterli değil.
Diğer sayfada nereye yazılacak,hangi sütuna,alt altamı yazılacak,yoksa sayfa temizlenip baştanmı yazılacak.Falan,falan,falan.

 

[YusufTure]

Soldan birinci kırmızı bölge ilk verim.Başlangıç.
ikinci veri 6 sütun sonraki yani ortadaki kırmızı veri.

diğer sayfa 2 ye yazdırılacak alt alta olacak şekilde.bu sayfa duracak
başka bir sayfaya alt alta olacak şekilde yazılacak

 

[Orion1]

Soldan birinci kırmızı bölge ilk verim.Başlangıç.
ikinci veri 6 sütun sonraki yani ortadaki kırmızı veri.

diğer sayfa 2 ye yazdırılacak alt alta olacak şekilde.bu sayfa duracak
başka bir sayfaya alt alta olacak şekilde yazılacak

Biz bunu anlamayız.Excelde, soldan birinci bölge sağdan üçücü bölge alttan 7nci bölge gibi tanımlamalar hiç bir şey ifade etmez.Sütun bazında hücre refaransı bazında konuşursanız konu çözümü için gerekli doneleri vermiş olacaksınız.Mesela B sütundan 7 sütun sonrasındaki hücreler gibisinden.Veya direk adresi verebilirsainiz,K sütundaki hücreler gibisinden.

 

[YusufTure]

D4 deki verim 1. başlangız verim.
2. verim ise K4 3. veri ise R4

istediğim ise ;

Sayfa 2

1.veri ( A1 )
2.Veri ( A2 )
3.Veri ( A3 )

vb...

Devam ediyor...

 

[Orion1]

Bir örnek dosya eklermisiniz.
Üzerine 4-5 satır veri girmeniz yetrlidir.

 

[YusufTure]

Tamam tamam
onuda yapayım

 

[YusufTure]

Dosya ektedir.

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub atlayarak_ziplayarak_aktar_59()
Dim sh As Worksheet, sat As Long, myarr()
Dim i As Long, a As Long
Sheets("sayfa1").Select
Set sh = Sheets("Sayfa2")
Application.ScreenUpdating = False
sh.Range("A:A").ClearContents
sat = Cells(65536, "D").End(xlUp).Row * 3
ReDim myarr(1 To 1, 1 To sat)
For i = 6 To sat
    If Cells(i, "D").Value <> "" And IsNumeric(Cells(i, "D").Value) Then
        a = a + 1
        myarr(1, a) = Cells(i, "D").Value
    End If
    If Cells(i, "K").Value <> "" And IsNumeric(Cells(i, "K").Value) Then
        a = a + 1
        myarr(1, a) = Cells(i, "K").Value
    End If
    If Cells(i, "R").Value <> "" And IsNumeric(Cells(i, "R").Value) Then
        a = a + 1
        myarr(1, a) = Cells(i, "R").Value
    End If
Next i
If a > 0 Then
    ReDim Preserve myarr(1 To 1, 1 To a)
    sh.Select
    Range("A1").Resize(a, 1) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "Aktarım tamamlandı" & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Application.ScreenUpdating = True
End Sub

 

[YusufTure]

Çok teşekkür ettim ...ellerine sağlık.
hemen hemen tam istediğim olmuş.

 

[Orion1]

Çok teşekkür ettim ...ellerine sağlık.
hemen hemen tam istediğim olmuş.

Rica ederim.
İyi çalışmalr.