Excel Adresler Arasında 1 Boşluk Kalsın Makro

Müşteri adreslerini A sütununa yığdığınız düzensiz bir dosyanız var diyelim. Firmalar arasında 1-2-3-5 gibi rastgele boşluklar verip kaydettiniz ve binlerce satır oldu. Fazla boşlukları silip sadece bir boşluk bırakmak için gerekli makro;

Sub xxx()
Dim son As Long
Application.ScreenUpdating = False
With Sheets("Sayfa1")
son = .Cells(Rows.Count, 1).End(3).Row
For i = son To 1 Step -1
If i = 1 Then GoTo var
If .Cells(i, 1) = "" And .Cells(i - 1, 1) = "" Then .Rows(i).EntireRow.Delete
Next
var:
End With
Application.ScreenUpdating = True
End Sub

Kaynak: Excelvba.net

Bir Cevap Yazın

This site uses Akismet to reduce spam. Learn how your comment data is processed.