aşağıya doğru satırları çoğaltma

[XExcel]

satır tekrarlatma işlemi

Selamlar,

başlıkta yazdığım olayın makro ile yaptırmak istiyorum, açıklama için eklediğim dosyaya bakabilirsiniz. Yardımlarınız için teşekürler

 

[hımmmmmmmm]

slm

1 den 10 a kadar sayılar hep aynımı

aynı ise, kırmızılara dokunulmayacak ise, macroya gerek yok...
ayrıca sayılar aynı ise senin sayı girip çoğalt butonuna tıklamanada gerek yok

eğer sayılar aynı ise ve 1000 satır yapacaksan ve sayfada illa macro istiyosan:
komut butonuna

Private Sub CommandButton1_Click()
For ı = 1 To 1000
  For k = 1 To 10
     Cells(ı, k) = k
  Next k
Next ı
End Sub

demek kafi...aşağıya doğru 1000 satırlık 1den 10 a kadar alt alta sayı yazar

 

[XExcel]

hayır sayılar hep aynı olmayacak, farklı olacak bu yüzden yukarki makroya buna göre ilave yapılmalı, bu arada dosyayı güncelleyip yeniden ekledim

 

[hımmmmmmmm]

slm

çalışma ekde

 

[Korhan Ayhan]

Merhaba,

Bende örnek bir dosya hazırladım. Alternatif olarak incelermisiniz.

Uygulanan kod;

Option Explicit
 
Sub KOPYALA()
    Dim X As Long
    
    Application.ScreenUpdating = False
    
    Columns("A:J").Borders.LineStyle = 0
    Range("A" & Range("K7") + 1 & ":J" & Rows.Count).ClearContents
    
    For X = Range("K7") + 1 To Range("K8") Step Range("K7")
        Range("A1:J" & Range("K7")).Copy
        Range("A" & X & ":J" & X + Range("K7")).PasteSpecial xlPasteValues
    Next
    
    Range("A1:J" & Cells(Rows.Count, 1).End(3).Row).Borders.LineStyle = 1
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[XExcel]

Teşekür ederim gayet güzel olmuş, hımmmmmmmm

User forma 1 txt kutucuğu daha ekleyebilirmiyiz. Sebebi ise şu anki şekli ile çoğaltma işlemi tek bir kez yapılım döngü sonlanıyor, oysam ben döngünün user forma eklenecek 3.txt kutucuğunda yazacağım rakamdaki satıra kadar tekrarlandıktan sonra sonlanmasını istiyorum. örnek: Başlangıç satırı (1) , Bitiş Satırı (5), Sonlanma satırı (1000) böylelikle döngü aynı işlemi yapmaya yazılan rakama kadar devam edicek.

 

[XExcel]

Korhan Hocam, sizin dosyanız tam istediğim gibi olmuş. Çok teşekkürler ederim

 

[Necdet]

Merhaba,

Bir alternatifte benden olsun. Döngüsüz

Sub Kopyala()
 
    Dim Adt As Integer, _
        Bs  As Integer, _
        Bt  As Integer
        
    Adt = [K7]
    Bs = Adt + 1
    Bt = Adt + ((Int(1000 / Adt) * Adt))
    Range("A1:J" & Adt).Copy
    Range("A" & Bs & ":J" & Bt).Select
    ActiveSheet.Paste
    
End Sub