DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Insert_Blank_Rows()
Dim X As Long
Application.ScreenUpdating = False
For X = Cells(Rows.Count, 6).End(3).Row To 2 Step -1
If Cells(X, 6) = Cells(X - 1, 6) Then
Rows(X).Insert
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub