Satır Tekrarlatmak

[ezkurtcan]

Merhaba;
Excel'de ufak bir makroya ihtiyacım var. Yardımcı olursanız sevinirim.

A sutunda her hangi bir hücreye yazdığım sayı kadar sağındaki değeri aşağı doğru tekrarlatmak istiyorum. Bunun kodunu nasıl yazabilirim.
Örnek vermek gerekirse;
B3 Hücresinde Ali yazıyor. A3'e 3 yazınca B3-B4-B5 Hücrelerine Ali yazacak.

Şimdiden yardımlarınız için teşekkür ederim.

 

[Necdet]

Merhaba,

A3 = Adet
B3 = Değer olmak kaydıyla aşağıdaki kodu kullanabilirsiniz.

Sub Makro1()
        
    Range("B3:B" & Range("A3") + 3 - 1).FillDown
    
End Sub

 

[ezkurtcan]

hızlı cevabınız için teşekkür ederim ama A sutununda her hangi bir hücreye her hangi bir değer girebilmeliyim.
Girdiğim değere göre bir sağındaki hücreyi o değer kadar aşağıya kopyalamalı.

 

[ezkurtcan]

cevap lütfen

 

[Huseyinkis]

cevap lütfen

Ekteki kodları çalışma sayfasının kod bolumune yapıştırıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A65536]) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
For i = 1 To Target.Value - 1
AAa = Cells(Target.Row, 2).Value
Cells(Target.Row + i, 2).Value = AAa
Next
End If
End Sub

 

[Necdet]

Merhaba,

Yanıt verilmiş, alternatif olsun, yine serilerle çözüm.

Kodlar yine ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error Resume Next
    If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    Dim Sat As Long
    Dim i   As Integer
    
    If Application.WorksheetFunction.CountA( _
        Range("A" & Target.Row & ":B" & Target.Row)) = 2 Then
        Application.EnableEvents = False
        If IsNumeric(Range("A" & Target.Row)) Then
            Sat = Target.Row
            i = Range("A" & Sat)
            Range("B" & Sat & ":B" & Sat + i - 1).FillDown
            Application.EnableEvents = True
        End If
    End If
    
End Sub