Aynı sayfada 2 makro? Tek makroda 2 işlem?

[ywzyilmaz]

Herkese Merhaba

Dün bu forumda "askm" kullanıcısının ciddi katkısıyla güzel bir makro oluşturdum. Biraz geliştirmek istiyorum. Şuan ki geçerli makro kodumuz şu şekilde.

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

Yapmak istediğim şey şu :
Alttaki ilk tablo veri sayfasının örneği, 2.tabloise etiket sayfasının örneği. Veri sayfasındaki değerler kullanıcı tarafından girilecek. Makronun yapmasını istediğim şey B2 hücresinde yazan değeri(5A15,1767,2C30...) sonuna 001,002,003 ekleyerek C2 hücresinde girilen sayı kadar 2 şer adet üretmesi ve etiket sayfasın B1 hücresinden aşağı doğru sıralı yazması. Ve A2 hücresindeki değeri C2den ürettiği adet kadar üretip etiket sayfasındaki A1den başlayıp aşağı doğru yazması. Aynı zamanda D2 hücresinde yazan değeri de aynı adette üretip etiket sayfasındaki C1 hücresinden aşağı doğru yazmasını istiyorum.

Örneklendirmeye çalışacağım.

Veri sayfası :

Makine No	Baz Kodu	Etiket Adet	Kontrol Memuru
230	5A15	2	KM01

Etiket Sayfası :

230	5A15-001	KM01
230	5A15-001	KM01
230	5A15-002	KM01
230	5A15-002	KM01

En üstte verdiğim kodla uğraşarak yapmaya çalıştım ama olmadı. Uzun uzun anlattım. Yardımcı olmak isteyen birisi olursa çok memnun olurum.

 

[ywzyilmaz]

Yardımcı olabilecek kimse yok mu?

 

[ywzyilmaz]

Kopya etiket.xlsm - 18 KB

Üzerinde çalıştığım dosyanın linki ektedir.

 

[bycakir]

buyrun kontrol edin