YANINDAKİ SAYI ADEDİ KADAR ÇOĞLATMA

[gumrukdisticaret]

5002	6		500250025002500250025002
630267	33		630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267630267

MERHABA ARKADAŞLAR SOLDAKİ RAKAMLARI YANINDA Kİ ADETLERİ KADAR ALT ALTA ÇOĞLATMAK İSTİYORUM.
=YİNELE(A1;B1) OLARAK YANINDAKİ ADET KADAR ÇOĞLATTIM FAKAT BUNLARI YAN YANA DEĞİL AYRI AYRI SÜTUNLARA GETİRMEK İSTİYORUM

 

[Necdet]

Merhaba,
Makrolu çözüm isterseniz, deneyiniz.

kod A ve B sütununu Alır , E sütununda alt alta listeler.

Public Sub cogalt()

Dim arr As Variant
Dim i   As Long
Dim b   As Long
Dim s   As Long

Application.ScreenUpdating = False
arr = Range("A1").CurrentRegion
Range("E:E").ClearContents

For i = LBound(arr, 1) To UBound(arr, 1)
    b = Cells(Rows.Count, "E").End(3).Row + 1
    Range("E" & b & ":E" & b + arr(i, 2) - 1) = arr(i, 1)
Next i

Application.ScreenUpdating = True

End Sub

 

[gumrukdisticaret]

HOCAM HATA VERDİ.
ALT+F11
INSERT
MODULE
F5


YAPIYORUM OLMUYOR

A1

5002

B1

6

C1
500250025002500250025002

Merhaba,
Makrolu çözüm isterseniz, deneyiniz.

kod A ve B sütununu Alır , E sütununda alt alta listeler.

Public Sub cogalt()

Dim arr As Variant
Dim i   As Long
Dim b   As Long
Dim s   As Long

Application.ScreenUpdating = False
arr = Range("A1").CurrentRegion
Range("E:E").ClearContents

For i = LBound(arr, 1) To UBound(arr, 1)
    b = Cells(Rows.Count, "E").End(3).Row + 1
    Range("E" & b & ":E" & b + arr(i, 2) - 1) = arr(i, 1)
Next i

Application.ScreenUpdating = True

End Sub

 

[Necdet]

Verdiğim kodda sizin önerdiğiniz veri yapısı var. sadece A ve B sütunu dolu olmalı, Birinci satırdan başlamalı veri. Ayrıca B sütunundaki Adet sayısını da kontrol etmedim, boş olmaması gerek.