bir çalışma sayfasındaki bilgileri, içindeki yıl değerini alt alta artırarak yazdırma

[ocannn]

Arkadaşlar merhaba,
Ekte örneği olan tabloya benzer bir sayfam var yaklaşık 15.000 adet bu şekilde tek tabloda ürün mevcut.Burada ürünlerin ilk ve son üretim tarihleri var. Listeyi her ürün için ilk yıldan son yıla kadar yılları da artırarak alt alta yazdıracak bir makro nasıl yazılabilir. Yardımcı olabilir misiniz?
Not: Bir ürün için örnek_çıktı sayfasında nasıl bir sonuca ulaşmaya çalıştığımı görebilirsiniz.

Teşekkürler.

 

[YUSUF44]

Sıralama özelliği işinizi görmüyor mu?

 

[ocannn]

Her satırada bir ürünün giriş ve çıkış yılı var (örneğin 1994-2012) bunu her satıra yıl bilgisi bir artarak 2012'ye kadar olacak şekilde ve 15.000 satır ürün için sıralama özelliği ile yapamayız diye biliyorum. Sıralama yalnızca seçtiğimiz sütun/sütunlara göre veriyi düzenlemiyor mu? Benim ihtiyacım olan ekli dosyada örnek tablodaki verinin örnek çıktıdaki gibi elde edilmesi

 

[mancubus]

Sub Yillara_Yay()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ss1 As Long, ss2 As Long, i As Long, yilSay As Long
    Dim mlzRng As Range
    
    Set ws1 = Worksheets("ÖRNEK TABLO")
    Set ws2 = Worksheets("ÖRNEK_ÇIKTI")
    
    With ws2
        .Cells.Clear
        .Range("A1:F1").Value = Array("MALZEME ADI", "GİRİŞ YILI", "URUN KOD", "DEPO", "AÇIKLAMA", "PARÇA NO")
    End With
    
    With ws1
        ss1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set mlzRng = .Range("A2:A" & ss1)
        For Each cll In mlzRng
            yilSay = .Range("C" & cll.Row) - .Range("B" & cll.Row) + 1
            For i = 1 To yilSay
                ss2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
                ws2.Range("A" & ss2 + 1).Value = .Range("A" & cll.Row)
                ws2.Range("B" & ss2 + 1).Value = .Range("B" & cll.Row) + (i - 1)
                ws2.Range("C" & ss2 + 1).Value = .Range("D" & cll.Row)
                ws2.Range("D" & ss2 + 1).Value = .Range("E" & cll.Row)
                ws2.Range("E" & ss2 + 1).Value = .Range("F" & cll.Row)
                ws2.Range("F" & ss2 + 1).Value = .Range("G" & cll.Row)
            Next
        Next
    End With

End Sub

 

[ocannn]

Çok teşekkürler, emeğinize sağlık.
Tam çözüm oldu soruna.

 

[mancubus]

rica ederim.
kolay gelsin.