Soru Tabloya göre sıralı veri alma ve tekrarlama

[angloth]

Merhaba.
Ekte sunduğum Excel dosyasında,

ornek.xlsx dosyasını indir - download

ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

- Liste sayfasında bulunan D sütunu ve F sütununda yazılı verileri sıralı bir şekilde (D4 - F4) Tevdi listesi sayfasında bulunan tablodaki B sütunu ve C sütununa (B6 - C6) kopyalamak istiyorum. Tevdi listesi sayfasında bulunan tablo dolduğunda çıktı alıp kaldığı sıradan tekrar liste bitene kadar aynı işlemi tekrar etmesini istiyorum. Bunu yapmak mümkün mü acaba ?

Şimdiden yardımcı olacak arkadaşlara teşekkür ederim.

 

[ÖmerFaruk]

Ek yok.

 

[angloth]

Ek yok.

Ekledim tekrar Ömer abi kusura bakmayın

 

[angloth]

Yardım edebilecek yok mu acaba.

 

[ÖmerFaruk]

Aşağıdaki kodları bir MODULE içine ekleyip çalıştırabilirsiniz.

Sub DoldurYazdır()
Dim Veri, Liste, i As Integer, k As Byte
    Veri = Worksheets("LİSTE").Range("D4:F" & Worksheets("LİSTE").Range("D" & Rows.Count).End(3).Row).Value
    ReDim Liste(1 To 33, 1 To 2)
    For i = LBound(Veri, 1) To UBound(Veri, 1)
        k = k + 1
        Liste(k, 1) = Veri(i, 1)
        Liste(k, 2) = Veri(i, 3)
        If k = 33 Or i = UBound(Veri, 1) Then
            With Worksheets("TEVDİ LİSTESİ")
                .Range("B6:C38").ClearContents
                .Range("B6").Resize(k, 2) = Liste
                .PrintOut
            End With
            k = 0
            ReDim Liste(1 To 33, 1 To 2)
            If i = UBound(Veri, 1) Then Exit Sub
        End If
    Next i
End Sub

 

[angloth]

Aşağıdaki kodları bir MODULE içine ekleyip çalıştırabilirsiniz.

Sub DoldurYazdır()
Dim Veri, Liste, i As Integer, k As Byte
    Veri = Worksheets("LİSTE").Range("D4:F" & Worksheets("LİSTE").Range("D" & Rows.Count).End(3).Row).Value
    ReDim Liste(1 To 33, 1 To 2)
    For i = LBound(Veri, 1) To UBound(Veri, 1)
        k = k + 1
        Liste(k, 1) = Veri(i, 1)
        Liste(k, 2) = Veri(i, 3)
        If k = 33 Or i = UBound(Veri, 1) Then
            With Worksheets("TEVDİ LİSTESİ")
                .Range("B6:C38").ClearContents
                .Range("B6").Resize(k, 2) = Liste
                .PrintOut
            End With
            k = 0
            ReDim Liste(1 To 33, 1 To 2)
            If i = UBound(Veri, 1) Then Exit Sub
        End If
    Next i
End Sub

çok teşekkür ederim Ömer bey istediğim gibi olmuş. elinize sağlık.