Bir Sayfadan Diğer Sayfaya Satır Oluşturma

[ywzyilmaz]

Herkese Merhaba

Çalışma kitabında 2 sayfa oluşturdum. Veri sayfasında A2 sütununda makine numarası, B2 sütununda baz kodu, C2 sütununda etiket adeti yazacak. Bunları ben gireceğim. Forumdaki aramamda şöyle bir kod buldum.

Sub Benzersizkod()
    Dim Veri, son As Long, say As Integer, Liste()
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then Exit Sub
    Range("D2:D" & Rows.Count).ClearContents
    Veri = Range("A2:B" & son).Value
    ReDim Liste(1 To WorksheetFunction.Sum(Range("B2:B" & son)), 1 To 1)
    For i = 1 To UBound(Veri)
        For k = 1 To Veri(i, 2)
            say = say + 1
            Liste(say, 1) = Veri(i, 1) & Format(k, "00")
        Next k
    Next i
    Range("D2").Resize(say, 1) = Liste
End Sub

Bu kod işlemi aynı sayfa içinde yapıyor. dediğim gibi veri sayfasından çekecek şekilde nasıl düzenleyebilirim?

Yardımcı olabilecek varmı? Şimdiden teşekkür ederim.

 

[ywzyilmaz]

Bu kod işlemi aynı sayfa içinde yapıyor. dediğim gibi veri sayfasından çekecek ve her satırdan alt alta 2 kopya yazacak şekilde nasıl düzenleyebilirim? B2 sütunundaki veriyi C2 adedince çoğaltacak. Ama hepsinden 2 tane yapması lazım.

Örn :

230 1767-001
230 1767-001
230 1767-002
230 1767-002


Yardımcı olabilecek varmı? Şimdiden teşekkür ederim.

 

[askm]

Range("D2").Resize(say, 1) = Liste Bu u satırın başına Sheets("Sayfa2") ekleyip deneyin.

 

[ywzyilmaz]

Range("D2").Resize(say, 1) = Liste Bu u satırın başına Sheets("Sayfa2") ekleyip deneyin.

Sheets("Sayfa2") Range("D2").Resize(say, 1) = Liste

Bu şekilde yaptım ama çalışmadı. Diğer sayfaya yazmayı ve alt alta 2 aynı satır yazmayı da halledersem işlem tamam olacak.

bu arada

Liste(say, 1) = Veri(i, 1) & "-" & Format(k, "000")

araya tire ekleme işini şu şekilde hallettim.

 

[askm]

Sub Benzersizkod()
    Dim Veri, son As Long, say As Integer, Liste()
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then Exit Sub
    Range("D2:D" & Rows.Count).ClearContents
    Veri = Range("A2:B" & son).Value
    ReDim Liste(1 To WorksheetFunction.Sum(Range("B2:B" & son)), 1 To 1)
    For i = 1 To UBound(Veri)
        For k = 1 To Veri(i, 2)
            say = say + 1
            Liste(say, 1) = Veri(i, 1) & "-" & Format(k, "00")
        Next k
    Next i
    Sheets("Sayfa2").Range("A2").Resize(say, 1) = Liste
End Sub

 

[ywzyilmaz]

diğer sayfaya yazdırma işi de tamam. Çok teşekkür ederim. Fazla oluyorum galiba ama her satırdan alt alta 2 tane olacak şekilde yazdırabilir miyim?

 

[askm]

Aynı veriden alt alta 2 tane mi almasını istiyorsunuz.

 

[ywzyilmaz]

evet

Sheets("Sayfa2").Range("B1").Resize(say, 2) = Liste

şunu yapmayı denedim. Yanyana 2 sütun'a yazıyor.

 

[askm]

Aşağıdaki şekilde mi?

Sub Benzersizkod()
    Dim Veri, son As Long, say As Long, Liste()
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then Exit Sub
    Sheets("Sayfa2").Range("A2:A" & Rows.Count).ClearContents
    Veri = Range("A2:B" & son).Value
    ReDim Liste(1 To WorksheetFunction.Sum(Range("B2:B" & son)) * 2, 1 To 1)
    For i = 1 To UBound(Veri)
        For k = 1 To Veri(i, 2)
            For t = 1 To 2
                say = say + 1
                Liste(say, 1) = Veri(i, 1) & "-" & Format(k, "00")
            Next t
        Next k
    Next i
    Sheets("Sayfa2").Range("A2").Resize(say, 1) = Liste
End Sub

 

[ywzyilmaz]

Herşey için çok teşekkürler. istediğim dosyayı hazırladım.

 

[ywzyilmaz]

Aşağıdaki şekilde mi?

Sub Benzersizkod()
    Dim Veri, son As Long, say As Long, Liste()
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then Exit Sub
    Sheets("Sayfa2").Range("A2:A" & Rows.Count).ClearContents
    Veri = Range("A2:B" & son).Value
    ReDim Liste(1 To WorksheetFunction.Sum(Range("B2:B" & son)) * 2, 1 To 1)
    For i = 1 To UBound(Veri)
        For k = 1 To Veri(i, 2)
            For t = 1 To 2
                say = say + 1
                Liste(say, 1) = Veri(i, 1) & "-" & Format(k, "00")
            Next t
        Next k
    Next i
    Sheets("Sayfa2").Range("A2").Resize(say, 1) = Liste
End Sub

Tekrardan merhaba,

Bu kodda A2 hücresindeki veriyi sonuna B2 hücresindeki değer kadar "01,02,03" gibi sırasıyla ekleme yaparak, sayfa2 deki A2 hücresine yazdırıyoruz. Buraya kadar tamam.

Lakin şunu yapmaya çalışınca işin içinden çıkamadım. C2 hücresindeki değeri B2 hücresindeki değer kadar Sayfa2 deki A2 hücresinden başlayarak aynı şekilde alt alta yazmasını istiyorum. Bunu aynı kod içerisinde çalıştırabilir miyim?