2 satır arası 9 boş satır ekleme

[brunetblue]

Arkadaşlar merhaba
Ekteki dosyam da 2 veri arası 9 satır eklemek ve üstteki satırı eklenen boş 9 satıra aynen kopyalamak istiyorum bunu makro ile yapabilmem için yardımcı olur musunuz?
dosya link.http://s8.dosya.tc/server2/72ulzo/2_veri_arasi_9_satir_arttirma.xlsx.html

 

[alicimri]

Sayın brunetblue
Örneğinize göre A2 hücresini seçin, makroyu çalıştırın.
Hangi hücre seçili ise o hücrenin tüm satırını kopyalıyor, bu hücrenin bir altından itibaren, 9 satır ekliyerek yapıştırıyor.

Sub Makro2()
  satir = Selection.Row
     Rows(satir & ":" & satir).Copy
  Rows(satir + 1 & ":" & satir + 9).Insert Shift:=xlDown
End Sub

 

[brunetblue]

Sayın ali cimri merhaba
Veri dosyamdaki yukarıdan aşağıya dolu olan tüm satırlarıma bunu yapmak istiyorum.
Yaklaşık 8000 bin satırım var. 8000 satıra makro ile otomatik olarak nasıl yapabiliriz.

 

[veyselemre]

Sub test()
    lst = Range("A2:D" & Cells(Rows.Count, 1).End(3).Row).Value
    ReDim w(1 To UBound(lst) * 10, 1 To UBound(lst, 2))
    For i = 1 To UBound(lst)
        For j = 1 To 10
            For ii = 1 To UBound(lst, 2)
                w((i - 1) * 10 + j, ii) = lst(i, ii)
            Next ii
        Next j
    Next i
    [f2].Resize(UBound(w), UBound(w, 2)).Value = w
End Sub

 

[alicimri]

Yukarıda seçime göre yaptığım örneği tümüne göre uyarladım.

Sub Makro2()
say = Range("A65536").End(3).Row
For i = say To 2 Step -1
     Rows(i & ":" & i).Copy
  Rows(i + 1 & ":" & i + 9).Insert Shift:=xlDown
  Next
End Sub

 

[brunetblue]

Ali cimri bey
Makronuzu denedim çalışıyor.
Fakat çok ağır yaklaşık 15 dk da işlemi tamamlıyor hızlandırmak için ne yapabiliriz.

 

[alicimri]

Aşağıdaki gibi deneyin yine uzun sürüyorsa Sayın veyselemre'nin kodu hızlı çalışıyor onu kullanın.

Sub Makro2()
Application.ScreenUpdating = False
say = Range("A65536").End(3).Row
For i = say To 2 Step -1
     Rows(i & ":" & i).Copy
  Rows(i + 1 & ":" & i + 9).Insert Shift:=xlDown
  Next
 Application.ScreenUpdating = True
End Sub