Bir Hücre İçin Uygulanan Makroyu Tüm Hücrelerde Kullanm

[ozzzn]

Bir Hücre Ýçin Uygulanan Makroyu Tüm Hücrelerde Kullanm

Bir txt dosyasından kopyaladığım metinleri a1 hücresine tıklayıp mokroyu çalıştırdığımda aralarındaki boşluğa göre ilk pragraftaki boşluktan önceki cümleyi a1 satırına boşluktan soraki cümleyi a2 satırına yerleştiren ve bir satır boşluk bırakarak ikinci cümleyede aynı işlemi uygulayan bir makro düzenlemeye çalıştım bu makro sadece a12 hücresine kadar uygulandı şimdi ben bunu a12 den a1000 e kadar
aynı şekildemi devam etmeliyim yoksa daha basit bir yolu varmı umarım doğru ifade edebilmişimdir.Excel konusunda çok yeniyim bu site için ve ilgilenen arkadaşlar için çok Teşekkürler.

ActiveSheet.Paste
Range("B1").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("B4").Select
Selection.Cut
Range("A5").Select
ActiveSheet.Paste
Rows("6:6").Select
Selection.Insert Shift:=xlDown
Range("B7").Select
Selection.Cut
Range("A8").Select
ActiveSheet.Paste
Rows("9:9").Select
Selection.Insert Shift:=xlDown
Range("B10").Select
Selection.Cut
Range("A11").Select
ActiveSheet.Paste
Rows("12:12").Select
Selection.Insert Shift:=xlDown
End Sub

 

[Levent Menteşoğlu]

Bu tip tekrarlayan işlemler için döngü kullanmanız gerekir,döngüsüz yapmaya çalışırsanız binlerce satır yazmanız gerekir ki buuda çok mantıklı değil. Eğer sorunuzu tam olarak açıklayan bir örnek dosya eklerseniz yardımcı olmaya çalışırız, ayrıca döngülerle ilgili detaylı bilgi için EXCEL DERSANESİ başlığındaki aşağıdaki linkide inceleyebilirsiniz.

http://www.excel.web.tr/viewtopic.php?t=1902

 

[ozzzn]

Cevabınız için teşekkürler .Döngü formüllerinini uygulamaya çalıştım ama başarılı olamadım.Dosya yükleme konusundada talihsizlik yaşıyorum :kafa:
şunu yapabilirmiyiz Mesela A1 Satırından A1000 satırına kadar alt alta sayılar yazılı
ve her sayının arasına 1 satır eklenmesi gerekiyor bunun için alttaki formüle nasıl bir döngü ekleyebilirim

Sub Makro3()
'
' Makro3 Makro
' Makro Z tarafından 01.05.2005 tarihinde kaydedildi.
'

'
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Insert Shift:=xlDown
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:8cea0b2c36]Sub ekle()
Application.ScreenUpdating = False
For a = Cells(65536, 1).End(xlUp).Row To 2 Step -1
If Cells(a, 1) <> 0 Then Rows(a).EntireRow.Insert
Next
End Sub
[/vb:1:8cea0b2c36]
Eğer arada hiç boşluk yoksa aşağıdaki gibide olabilir.
[vb:1:8cea0b2c36]Sub ekle()
Application.ScreenUpdating = False
For a = Cells(65536, 1).End(xlUp).Row To 2 Step -1
Rows(a).EntireRow.Insert
Next
End Sub
[/vb:1:8cea0b2c36]