otomatik sayı atama

Merhaba elimde aşağıda ki gibi bir kod var bu kod excel de bir hücrede ki sayının sonuna istenilen sayıyı yine istenilen miktarda sayıyı sırasıyla yazıcıdan çıktısını almaya yarıyor,

Yani macroyu çalıştırdığımda cursor hangi hücredeyse o hücreye kaçtan kaça kadar yazdırmak istiyorsak yazdırabiliyorum,

Gelelim benim soruma; aşağıda ki kod tek bir hücrede geçerli yani bir hücrede istenilen sayıyı arttırarak yazıyor ben bu işlemi 4 hücrede yapmak istiyorum ve aynı zamanda aynı 4 hücrede ki rakamları aynı şekilde arttırarak yazdıracak bir kod istiyorum

mesela " kaçtan başlasın " inputboxı açıldığında 200 " Kaça Kadar " inputboxı açıldındığında 250 yazıyoruz, tamam a tıkladığımızda 200 den 250 ye kadar sırasıyla yazıcıdan çıkıyor, fakat tek bir hücrede ben 4 hücrede aynı işlem tekrarlansın istiyorum nasıl yardımcı olursunuz,

Sub adetyaz()
bas = InputBox("Kaçtan başlasın ?")
son = InputBox("Kaça kadar ?")
r = ActiveCell.Row
c = ActiveCell.Column

For i = bas To son
a = Cells(r, c)
Cells(r, c) = Cells(r, c) & i
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells(r, c) = a
Next i
End Sub

Teşekkürler

merhaba arkadaşım,
öncelikle böyle bir şeyi yapman için iki tane döngü sağlaman lazım. mesela örnek kodunda kullandın gibi iki tane for...next döngüsü. bu iki döngüyü de başlatabilmen için iki farklı girdi alman lazım. ya da her zaman için sadece 4 sütun/satır ayarı geçerliyse ikinci döngüyü bilgi almadan da gerçekleştirebilirsin (o zaman '...to 4' kodunu yazman gerekli (eğer sıfır tabanlıysa '...to 5' olur)) sana bu açıklama yettiyse sevindim, ama yeterli bulmadıysan yaz bi' cevap sana bir örnek kod yazayım. iyi çalışmalar.

yanıtı buldum işte kod :

Sub adetyaz10()
bas = InputBox("Kaçtan başlasın ?")
son = InputBox("Kaça kadar ?")
r = ActiveCell.Row
c = ActiveCell.Column

    For i = bas To son
        a = Cells(16, 20) 'T16
        b = Cells(41, 11) 'K41
        c = Cells(41, 16) 'P41
        d = Cells(41, 20) 'T41
        Cells(16, 20) = Cells(16, 20) & i
        Cells(41, 11) = Cells(41, 11) & i
        Cells(41, 16) = Cells(41, 16) & i
        Cells(41, 20) = Cells(41, 20) & i
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Cells(16, 20) = a
        Cells(41, 11) = b
        Cells(41, 16) = c
        Cells(41, 20) = d
    Next i

End Sub