Yardım Etiket Oluşturma İçin Makro

Herkese Merhaba

Biraz araştırma ve biraz soru cevapla şöyle bir makro kodu oluşturdum fakat işimi tam olarak görmedi :

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

Genişletmek için tıkla ...

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ı:

Etiket Sayfası:

Ortadaki sıralı kodu makro ile ürettirmeyi başardım. Diğerlerini de formül ile [=EĞER(B1>0;veri!C2;"")] yaptım aslında ama işimi görmedi. Yazdırma sayfası olduğu için makro ile üretip her yeni etiket basımında sayfayı sıfırlayabilmem lazım.

Çalışma yaptığım dosya linki alttadır. Yardımcı olan olursa çok minnettar olurum.
İndir Kopya etiket xlsm

Merhaba
Dosyadan kontrol edebilirsiniz.