Makroyu Tekrarlamak

[coşkun79]

Ekteki örnek dosyanın "A" sayfasında "yapıştır" butonuna bir makro atadım. Bu makro şöyle çalışıyor:
1- "A5" hücresinin değerini arttırıyor. ("A5" hücre değerine göre B5:I5 aralığındaki veriler değişiyor. "Veri" sayfasından veri alıyor.)
2- B5:I5 aralığındaki verileri kopyalıyor.
3- Kopyalanan verileri tablodaki son dolu satırın altına (ya da ilk boş satıra) değer olarak yapıştırıyor.

"yapıştır" butonuna tıklayarak bunu görebilirsiniz. Ben bu işlemi "A6" hücre değerine kadar ( bu hücre dahil) yapıyorum. (Çünkü "A6" hücresi "veri" sayfasındaki dolu satırların sayısı.)
Yapmak istediğim şu: Bu makroyu tek tek tıklayarak çalıştırmak istemiyorum. Bunun yerine tek tıklama ile "A6" hücre değerine kadar ( bu hücre dahil) kopyala yapıştır işlemini tek seferde yapmak istiyorum. Makro en son "A6" hücre değerine göre kopyala-yapıştır işlemini yaptıktan sonra ise dursun istiyorum. Buna göre mevcut makromu nasıl değiştirebilirim?

NOT:Normalde "Veri" sayfasındaki verileri indis formülü ile "A" sayfasına alabilirim. Ancak makroyu belli şart gerçekleşene kadar çalıştırma yöntemini öğrenmek istiyorum. Örnek dosya sadece konunun anlaşılması için eklenmiştir.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub YAPIŞTIR()
'
' YAPIŞTIR Makro
'

'
[A5] = 0
For i = 0 To [A6] - 1
    Range("A5") = Range("A5") + 1
    Range("B5:I5").Select
    Selection.Copy
    NoA = Columns("B").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
    Range("B" & NoA).Select
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next

End Sub

 

[YUSUF44]

Şöyle daha hızlı olabilir:

Sub YAPIŞTIR()
'
' YAPIŞTIR Makro
'

'
[A5] = 0
For i = 0 To [A6] - 1
    Range("A5") = Range("A5") + 1
    Range("B5:I5").Select
    Selection.Copy
    Set b = Range("B8:B" & Rows.Count).Find("")
    If Not b Is Nothing Then b.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next

End Sub

 

[coşkun79]

Allah razı olsun. Harikasınız

 

[coşkun79]

Yusuf Bey ikinci önerinizde makro sekizinci satırı atlıyor. Dokuzuncu satırdan başlıyor. Bilginize

 

[coşkun79]

DÜZELTME: Set b = Range("B8:B" & Rows.Count).Find("")
Yukarıdaki satırı B7 olarak değiştirince düzeldi. tekrar teşekkür ederim.