Bosluk Sil

[pelin5353]

Asagidaki macroyu dolu satırlar arasinda 1'er satir birakacak sekilde duzenleyebilir miyiz?

Sub boşluksil()
t = Range("A65536").End(xlUp).Row
For i = t To 8 Step -1
If Cells(i, 1) = "" Then
Cells(i, 1).EntireRow.Delete xlShiftUp
End If
Next
End Sub

 

[Recep İpek]

1 satır boşluk, bir satır dolu mu olmasını istiyorsunuz?

 

[Orion1]

Merhaba.
Önce Boşluk sil makrosunu çalıştırınız.
Boşluk sil makrosundan sonra aşağıdaki makroyu çalıştırıp denermisiniz?

Sub satir_ekle()
Dim sonsat As Long, i As Long
sonsat = Cells(65536, "A").End(xlUp).Row
For i = sonsat To 8 Step -1
    Rows(i).Insert Shift:=xlDown
Next
End Sub

 

[Seyit Tiken]

Aşağıdaki kodu deneyiniz.

Sub Düğme1_Tıklat()
For s = [a65000].End(3).Row To 1 Step -1
If Cells(s, 1) <> "" Then Cells(s, 1).Insert Shift:=xlDown
Next
End Sub

 

[pelin5353]

Oncelikle ilginiz icin tesekkurler. SAyin Sezar verdiginiz makro her satirin arasina birer adet bos satir ilave ediyor. Benim ihtiyacim olan ise ekte de anlattigim uzere dizilerin arasinda 1'er adet satir kalmasi ve digerlerini silmesi...

 

[Seyit Tiken]

Bu &#351;ekilde deneyiniz.

Sub D&#252;&#287;me1_T&#305;klat()
[A65000].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
For s = [A65000].End(3).Row To 1 Step -1
If Cells(s, 1) <> "" Then Cells(s, 1).Insert Shift:=xlDown
Next
End Sub

 

[Orion1]

Merhaba.
Aşağıdaki kodları denermisiniz.

Sub satir()
Dim t As Long, i As Long
t = Range("A65536").End(xlUp).Row
For i = t To 8 Step -1
If Cells(i, 1) = "" Then
Cells(i, 1).EntireRow.Delete xlShiftUp
If Cells(i - 1, "A") <> "" Then
    Rows(i).Insert Shift:=xlDown
End If
End If
Next
End Sub

 

[pelin5353]

Sayin Sezar ve Seyit Bey Cok tesekkurler ,

Sezarin gonderdigi macro biraz daha uygun oldu. Bide birlestirilmis hucreler gitmese daha guzel olurdu ama abartmayayim...

YArdimlariniz icin tesekkurler

 

[Orion1]

Rica ederim.
İyi geceler.