Kritere göre satır ekletmek

[sakoz]

Merhabalar ,

Ekte gönderdiğim dosyada A sütununda Poz No var...Burada aynı poz.nosundan birden fazla var...
Şimdi yapmak istediğimiz poz.nosu her değiştiğinde araya bir satır ekletmek...
yani ;
A2 'de 13937 var.
A3 'de 13937 var.
A4 Boş satır olacak.
A5 'de 13938 var.
A6 'de 13938 var.
A7 'de 13938 var.
A8 'de 13938 var.
A9 Boş satır olacak..
Bu şekilde poz.nosu her değiştiğinde otomatik olarak boş bir satır ekletmemiz mümkünmüdür ?
İlgilenen herkese şimdiden teşekkür ederim.
Saygılar...

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu standart bir module sayfasına kopyalayıp, çalıştırınız.

Sub Poz_No_Degistiginde_Satir_Ac()
    Dim i As Integer
    Dim x As Integer
    Dim sKon As String
    Dim rng As Range
    
    On Error GoTo Hata_Yakala
    
    For i = 2 To Cells(65536, 1).End(xlUp).Row
        If i = 2 Then
            sKon = Cells(i, 1)
        Else
            If Cells(i, 1) <> sKon Then
                sKon = Cells(i, 1)
                x = x + 1
                If x = 1 Then
                    Set rng = Cells(i, 1)
                Else
                    Set rng = Application.Union(rng, Cells(i, 1))
                End If
            End If
        End If
    Next i
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    rng.EntireRow.Insert
 
Hata_Yakala:
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Set rng = Nothing
End Sub

 

[sakoz]

Ferhat Hocam ,

Yine ustalığınızı konuşturmuşsunuz...Makro süper çalışıyor...
Size nasıl teşekkür etsem azdır...Ellerinize ve emeginize sağlık...Saolun...varolun...