otomatik satır ekleme

[nes432]

merhaba, 150 civarı alt alta verim var her satırın altına 7 satır otomatik eklemesini istiyorum bu eklenen satırlara da aynı 7 veriyi alt alta otomatik girmek istiyorum. ( Bu veriler;ANKARA, İSTANBUL,İZMİR,KONYA, SİVAS, KAYSERİ,ERZURUM). arama yaptım ama istediğim gibi birşey daha önce yapılmamış

 

[spacebar]

module şu kodları yazınız:

Sub BosSatirEkle()
  Dim Line As Integer
  Range("A2").Select
  Line = 1
Recommence:
  Line = Line + 7
  Rows(Line).Select
  Selection.Insert Shift:=xlDown
  If Line < ActiveSheet.UsedRange.Rows.Count Then
    GoTo Recommence
  End If
End Sub

 

[nes432]

module şu kodları yazınız:

Sub BosSatirEkle()
  Dim Line As Integer
  Range("A2").Select
  Line = 1
Recommence:
  Line = Line + 7
  Rows(Line).Select
  Selection.Insert Shift:=xlDown
  If Line < ActiveSheet.UsedRange.Rows.Count Then
    GoTo Recommence
  End If
End Sub

her 6 satırda 1 boşluk ekledi. her satırın altına 7 boşluk istiyorum.

 

[spacebar]

şunu deneyiniz :

Sub strekle()
Set s1 = Sheets("Sayfa3")
For i = 1 To 200
s1.Cells(i, 1).Activate
s1.Rows(i + 1 & ":" & i + 7).Select
Selection.Insert Shift:=xlDown
i = i + 7
Next i
End Sub

sayfa3 olan yere sayfa ismini yazınız. to 200 de 200 veriye kadar çalıştırıyor.veriniz daha fazlaysa bunu düzenleyiniz.

 

[nes432]

şunu deneyiniz :

Sub strekle()
Set s1 = Sheets("Sayfa3")
For i = 1 To 200
s1.Cells(i, 1).Activate
s1.Rows(i + 1 & ":" & i + 7).Select
Selection.Insert Shift:=xlDown
i = i + 7
Next i
End Sub

sayfa3 olan yere sayfa ismini yazınız. to 200 de 200 veriye kadar çalıştırıyor.veriniz daha fazlaysa bunu düzenleyiniz.

tamamdır işe yaradı çok teşekkür ederim