Farklı numara olması durumunda

[1903emre34@gmail.com]

Merhabalar,

aşağıdaki kod ile B sutündaki eski ve yeni numaralarda farklı durum olursa, numaralar arasında iki satır arası açıyor, yalnız iki satır yerine bir satır aralığını açmasını istiyorum

Sub Düğme3_Tıklat()

Dim R As Long
Application.ScreenUpdating = False
For R = Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1
If Cells(R, "B") <> Cells(R - 1, "B") Then
Cells(R, "B").EntireRow.Insert Shift:=xlUp
Cells(R, "B").EntireRow.Insert Shift:=xlUp
End If
Next R
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
End Sub

 

[kemal turan]

Not: geri dönüş yapılmadığı için cevap silinmiştir.

 

[numan şamil]

Merhaba
biraz daha süre verelim bakalım dönüş olacak mı?

Cells(R, "B").EntireRow.Insert Shift:=xlUp

bir tanesini silip denermisiniz

 

[anemis]

Arkadaş bu sabah foruma giriş yapmış. Şöyle düşünüyorum eğer sorununa çözüm bulmuş olmasa idi "bu olmadı yardım lütfen" şeklinde bir cevabı olurdu elbet. Haliyle arkadaş cevabını almıştır diye düşünüyorum.

 

[1903emre34@gmail.com]

Merhaba
biraz daha süre verelim bakalım dönüş olacak mı?

Cells(R, "B").EntireRow.Insert Shift:=xlUp

bir tanesini silip denermisiniz

Kemal ve Numan bey, teşekkürler oldu.

iyi çalışmalar