Belirli Aralıktaki Sayıları Ardışık Yazdırma

[DMR 7]

Merhabalar,

Böyle bir excelim var. Bazen tekli bazen de aralık olarak giriş yapılacak seriler. İhtiyacım olan şey, "Stok Kodu - Seri Numaraları" şeklinde, adı "Seri Numaraları" olan başka bir excel sayfasına alt alta her satıra eklesin. Butonlu macro da olabilir. Satıra yeni bir seri girdikçe de olabilir ama buton sanırım daha sağlıklı.

İlk satır için; 546462 - 1 ilgili sayfadaki ilk satır olup aşağı doğru satır sırayla doldurmalı. Stok kodu sabit,
546462 - 2
546462 - 3
546462 - 4 şeklinde.

 

[ÖmerBey]

Merhaba,
Resimdeki sayfa aktifken kodu çalıştırınız...

Sub kod()
Dim s2 As Worksheet
Dim a As Long, b As Long, x As Long
ReDim dz(1 To 1)
Set s2 = Sheets("Seri Numaraları")
For a = 2 To Cells(Rows.Count, "B").End(3).Row
    If Cells(a, "B") <> "" Then
        For b = Cells(a, "D") To IIf(Cells(a, "E") <> "", Cells(a, "E"), Cells(a, "D"))
            x = x + 1
            ReDim Preserve dz(1 To x)
            dz(x) = Cells(a, "B") & " - " & b
        Next
    End If
Next
s2.Range("A1").Resize(UBound(dz)).Value = Application.Transpose(dz)
MsgBox "Tamam"
End Sub

 

[DMR 7]

Merhaba,
Resimdeki sayfa aktifken kodu çalıştırınız...

Sub kod()
Dim s2 As Worksheet
Dim a As Long, b As Long, x As Long
ReDim dz(1 To 1)
Set s2 = Sheets("Seri Numaraları")
For a = 2 To Cells(Rows.Count, "B").End(3).Row
    If Cells(a, "B") <> "" Then
        For b = Cells(a, "D") To IIf(Cells(a, "E") <> "", Cells(a, "E"), Cells(a, "D"))
            x = x + 1
            ReDim Preserve dz(1 To x)
            dz(x) = Cells(a, "B") & " - " & b
        Next
    End If
Next
s2.Range("A1").Resize(UBound(dz)).Value = Application.Transpose(dz)
MsgBox "Tamam"
End Sub

Hocam emeğine sağlık. Bir şey daha sorabilir miyim? 2. sayfaya serileri yazdırdık ya, 2. kolona bir veri daha taşıyabilir miyiz? SS'teki C kolonundaki veriyi misal satır bazlı yazabilir miyiz? İlk satır için 100 farklı seri var ama C kolonundaki veri tek olacak ama alt alta yazılacak. Nasıl bir ekleme yapmak gerek? Yardımcı olabilir misiniz?

EDİT: Halletim hocam gerek kalmadı.