Verilerin arasına boş satır ekleyecek kod.

[simetri.]

Merhabalar,

01.11.2013
01.11.2013
02.11.2013
02.11.2013

üstteki şekilde olan bir görüntüyü

aşağıdaki gibi yapacak kod gerekli değerli arkadaşlar.

araya boş satır ilave etmemiz gerikiyor. Lütfen bir el atın. Teşekür ederim.

01.11.2013
01.11.2013

02.11.2013
02.11.2013

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Ekle()
 
    Dim i As Long
 
    Application.ScreenUpdating = False
 
    For i = Cells(Rows.Count, "B").End(xlUp).Row To 4 Step -1
        If Cells(i, "B") <> "" And Cells(i - 1, "B") <> "" Then
            If Cells(i, "B") <> Cells(i - 1, "B") Then
                Cells(i, "B").Insert Shift:=xlDown
                'Rows(i).EntireRow.Insert'tüm satır için
            End If
        End If
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[simetri.]

Ömer hocam çok teşekkür ederim. Elinize sağlık.

B ile beraber C D ve E sütunlarına da boşluk verebilirmi acaba?

'Rows(i).EntireRow.Insert'tüm satır için

üstteki satır var lakin sınırlı olursa daha iyi olacak.

 

[turist]

Alternatif dosya eklidir.

 

[Ömer]

Ömer hocam çok teşekkür ederim. Elinize sağlık.

B ile beraber C D ve E sütunlarına da boşluk verebilirmi acaba?

'Rows(i).EntireRow.Insert'tüm satır için

üstteki satır var lakin sınırlı olursa daha iyi olacak.

Cells(i, "B").Insert Shift:=xlDown

Yerine aşağıdakini yazarak deneyin.

Cells(i, "B").Resize(1, 4).Insert Shift:=xlDown

.

 

[simetri.]

Şimdi çok daha iyi oldu.

Tekrardan teşekkür ederim Ömer hocam.

Sayın turist alternatif kod için sizede teşekkür ederim.

Hayırlı akşamlar.