Makro formül iyileştirme

[Hakngnc]

Günaydın arkadaşlar ve üstadlar ,

x =TAMSAYI((BAĞ_DEĞ_DOLU_SAY(B:B)-1)/33) sonucunda çıkan bir değer

aşağıdaki makroyu tek tek yapmak yerine bir döngü yapılabilir mi ?

 Range("A1").Select
    ActiveCell.FormulaR1C1 = "İsimler"
    
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Kişiler!R3C1"
    Selection.AutoFill Destination:=Range("A2:A" & x), Type:=xlFillDefault
    
    Range("A" & x + 1).Select
    ActiveCell.FormulaR1C1 = "=Kişiler!R4C1"
    Selection.AutoFill Destination:=Range("A" & x + 1 & ":" & "A" & 2 * x), Type:=xlFillDefault
    
    Range("A" & 2 * x + 1).Select
    ActiveCell.FormulaR1C1 = "=Kişiler!R5C1"
    Selection.AutoFill Destination:=Range("A" & 2 * x + 1 & ":" & "A" & 3 * x), Type:=xlFillDefault
    
    Range("A" & 3 * x + 1).Select
    ActiveCell.FormulaR1C1 = "=Kişiler!R6C1"
    Selection.AutoFill Destination:=Range("A" & 3 * x + 1 & ":" & "A" & 4 * x), Type:=xlFillDefault

 

[ÖmerBey]

Şu döngüyü deneyiniz:

For a = 3 To Sheets("Kişiler").Range("A65500").End(3).Row
    Range(Cells((a - 3) * x + 1, 1), Cells((a - 2) * x, 1)) = Sheets("Kişiler").Cells(a, 1)
Next

 

[Hakngnc]

Çok teşekkür ederim.. Şimdi denedim çalıştı mantığını anlamaya çalışayım kolay gelsin
Elinize sağlık

 

[Hakngnc]

Evet mantığını da anladı.m ben her satır için ayrı ayrı for next yapıyordum beceremiyordum siz bir hamleyle bitirmişsiniz vallahi süper olmuş.

Tekrardan teşekkürler

 

[Hakngnc]

For a = 3 To Sheets("Kişiler").Range("A65500").End(3).Row
Bu formülün aynı mantığı b sutünu için
For a = 3 To Sheets("Kişiler").Range("B65500").End(3).Row değil mi aynı yeri kopyalıyorda ?

 

[isyankarzarar]

LÜTFENNN ACİİİLLLL YARDIMMM

MERHABALAR SAYIN HOCALARIM
excel de stok takibi yapmakta olduğum bir tabloda
L sütununda her hangi bir satıra her hangi bir değer girince 1 satır boşluk bırakan bu formülü yazmıştınız çalıştı
ancak
1-değer yazdığım hücreyi silince eklenen satırın silinmesi için ne yapmam gerekli
2-diğer bazı sütunlardaki S W X Z gibi var olan formüllerim eklenen satırda olmuyor ne yapmam gerekli

şimdiden teşekkürler...


Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L:L")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Rows(Target.Row + 1).Insert shift:=xlDown
Application.EnableEvents = True

 

[Hakngnc]

Buraya neden yazdın bunu?