şarta göre satır ekleme

[cengiz123]

merhabalar,
bir konuda yardımınıza ihtiyacım var.
konu ise;
A sütununda,
Toyota
Toyota
Toyota
BMW
BMW
Citroen
Citroen
Citroen
Citroen
VW
VW

şeklinde giden veriler var.

şöyle bir kod yazmamız mümkün mü?
A sütunun da hücre içindeki veriler değiştiğinde araya iki satır eklesin.
yani yukarıdaki örnektekinin olması gereken son hali aşağıdadır.
şimdiden herkese sonsuz teşekkürler
Toyota
Toyota
Toyota
...Boş satır
...Boş satır
BMW
BMW
...Boş satır
...Boş satır
Citroen
Citroen
Citroen
Citroen
...Boş satır
...Boş satır
VW
VW
...Boş satır
...Boş satır
..
..

 

[Asri]

Bu konudaki eklentiyi kullanabilir siniz. Mouse sağ tuş da çıkar ve tüm excel dosyalarında kullanabilir siniz.


http://www.excel.web.tr/f52/excel-zel-lemler-menusu-eklentisi-sao-tu-t157219.html

BOŞ SATIR İŞLEMLERİ :
*Hücre içine satır numarası ekle
*Boş satır ekle - her n satır sonra n satır ekle
*Boş satır ekle - x. karakter ile y. karakterler arası değiştiğinde n boş satır ekle
*Boş satır ekle - Bu kelimeyi içeren satırlardan sonra n kadar boş satır ekle
*Hücre değeri değiştiğinde n boş satır ekle
*Sıra numarası ekle - n den başla n artışla . karakteri ekle hücre içeriği silinir.
*Her dolu hücreden sonra, n boş satır ekle. Fazla boş satırlar silinmez.
*Her dolu hücreden sonra, n boş satır ekle. Fazla boş satırlar silinir.

 

[numan şamil]

Merhaba
kodların kırmızı yerlerini size uygun değiştirip
dener misiniz

Sub numan()
Dim x As Long
Application.ScreenUpdating = False
For x = [COLOR="Red"]2[/COLOR] To [COLOR="Red"]1000[/COLOR]
If Range("A" & x).Value <> "" And Range("A" & x - 1).Value <> "" Then
If Range("A" & x).Value <> Range("A" & x - 1).Value Then
Range("A" & x).Insert Shift:=xlDown
Range("A" & x).Insert Shift:=xlDown
End If
End If
Next x
Application.ScreenUpdating = True
End Sub

 

[cengiz123]

teşekkür ediyorum numan bey. denedim oldu.
baya uğraşmıştım. allah razı olsun

 

[numan şamil]

İyi çalışmalar