Satır sayısının artırılması

[MIND06]

Selam Arkadaşlar,

1 Ankara
2 Bursa
3 İzmir
vs
vs
vs
Her bir excel satırını aşağıdaki gibi kopyalayarak nasıl çoğaltabilirim?

1 Ankara
2 Ankara
3 Ankara
4 Bursa
5 Bursa
6 Bursa
7 İzmir
8 İzmir
9 İzmir

Yardımcı olursanız sevinirim..

 

[Emir Hüseyin Çoban]

. . .

Her değeri çoğaltma sayısı sabit mi 3 mü ?

. . .

 

[MIND06]

Örnek olsun diye yazmıştı..3 veya 10 arası olabilir..

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    
    sor = InputBox("Çoğaltılacak Satır Sayısını Girin")
    If sor = "" Then Exit Sub
    sor = sor - 1
    
    For i = 1 To (Cells(Rows.Count, "B").End(3).Row * sor) Step sor + 1
        For x = 1 To sor
            Rows(i + 1).Insert Shift:=xlDown
        Next x
    Next i
    
    For a = 1 To Cells(Rows.Count, "B").End(3).Row + (sor)
        Cells(a, "A") = a
        If Cells(a, "B") = "" Then
            Cells(a, "B") = Cells(a - 1, "B")
        End If
    Next a
    
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[Emir Hüseyin Çoban]

. . .

Alternatif.

Sub KOD2()
    Dim dizi()
    satır = 5[COLOR="Green"] ' ilave edilecek satır sayısı[/COLOR]
    son = Cells(Rows.Count, "B").End(3).Row
    
    For i = 1 To son
        For a = 1 To satır
            ReDim Preserve dizi(1, s)
            dizi(0, s) = s + 1
            dizi(1, s) = Cells(i, 2).Value
            s = s + 1
        Next a
    Next i
    
    Range("A1:B" & son).ClearContents
    Range("A1").Resize(s, 2).Value = Application.Transpose(dizi)
    
End Sub

. . .

 

[MIND06]

teşekkür ederim..