Satır Ekleme

[x2q59]

Selamün aleyküm

A1 den başlayan
A7125 e kadar bir liste var elimde

a1 den başlayıp 3 satır atlayıp A3 ile A4 arasına 3 boş satır ekleyecek
daha sonra (3+3)6 satır atlayarak 3 tane boş satır eklerek ilerleyen bir makro oluştura bilmemiz mümkün mü?

 

[Asri]

Excel de sağ tuş da çıkacak bu eklenti ile aşağıdak kriterlere göre boş satır ekleme yapabilirsiniz.

http://www.excel.web.tr/f52/excel-zel-lemler-menusu-eklentisi-sao-tu-t157219.html

BOŞ SATIR İŞLEMLERİ :
*Hücre içine satır numarası ekle
*Boş satır ekle - her n satır sonra n satır ekle
*Boş satır ekle - x. karakter ile y. karakterler arası değiştiğinde n boş satır ekle
*Boş satır ekle - Bu kelimeyi içeren satırlardan sonra n kadar boş satır ekle
*Sıra numarası ekle - n den başla n artışla . karakteri ekle hücre içeriği silinir.
*Her dolu hücreden sonra, n boş satır ekle. Fazla boş satırlar silinmez.
*Her dolu hücreden sonra, n boş satır ekle. Fazla boş satırlar silinir.
*Sıranumarası ekle, belirli bir sütundaki her değiştiğinde yeniden başla.
*Bulunduğu kolonda hücre değeri değiştiğinde n boş satır ekle
*Boş satır ekle - x. karakter ile y. karakterler arası değişmediğinde n boş satır ekle
*Boş satır ekle, sadece sayı olmayan hücrelere. Bunları karakter kabul et, bunları da sayı kabul et.
*Boş satır ekle, sadece sayı olan hücrelere. Bunları karakter kabul et, bunları da sayı kabul et.
*Boş satır ekle bu kelimeye göre,
-İle başlayanı
-İle başlamayanı
-İle biteni
-İle bitmeyeni
-İçereni
-İçermeyeni
-Eşit olani
-Eşit olmayanı
-Büyük olanı
-Küçük olanı
-Büyük yada eşit olanı
-Küçük yada eşit olanı

 

[Sinan2618]

Merhaba,

Aşağıdaki kod işinize yarar sanırım.

Sub Üç_Satir_Ekle()
    Dim a As Byte, sat As Byte
    [A2].Select
    a = 4: sat = 3
    While ActiveCell.Value <> ""
        ActiveSheet.Rows(ActiveCell.Row & ":" & sat + ActiveCell.Row - 1).Insert Shift:=xlDown
        ActiveCell.Offset(a, 0).Select
    Wend
    a = Empty: sat = Empty
End Sub

 

[askm]

Boş bir modul ekleyip aşağıdaki kodları deneyin.

Sub askm()
Set s1 = Sheets("Sayfa1")
s1.Cells(3, 1).Select
Selection.Insert Shift:=xlDown
For i = 6 To 7200 Step 6
s1.Cells(i, 1).Activate
s1.Rows(i + 1 & ":" & i + 3).Select
Selection.Insert Shift:=xlDown
Next i
MsgBox ("İşleminiz tamamlandı...")
End Sub

 

[x2q59]

Teşekkür ederim Arkaşdaşlar.