(13/09/2023, 17:58)feraz yazdı: Bu arada kodun daha hızlı olması için alttaki kodlardan birini kullanabilirsiniz.
Tabii normali olan ilk kod.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
   
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A7:F" & sonSatir)) Is Nothing Then
        Range("A7:A" & sonSatir).ClearContents
        On Error GoTo 10
        dizi = Range("B7:B" & sonSatir).Value2
        No = 1
            ReDim arr(1 To sonSatir, 1 To 1)
            For x = 1 To UBound(dizi)
                If dizi(x, 1) <> "" Then
                    arr(x, 1) = No
                    No = No + 1
                End If
            Next
        Range("A7").Resize(UBound(arr), 1).Value = arr
    End If
   
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
 
    Application.EnableEvents = False
    Range("A7:A" & sonSatir).ClearContents
    On Error GoTo 10
    dizi = Range("B7:B" & sonSatir).Value2
    No = 1
    Select Case Target.Column
        Case 1 To 6
        ReDim arr(1 To sonSatir, 1 To 1)
        For x = 1 To UBound(dizi)
            If dizi(x, 1) <> "" Then
                arr(x, 1) = No
                No = No + 1
            End If
        Next
    End Select
    Range("A7").Resize(UBound(arr), 1).Value = arr
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub

Teşekkür ederim feraz Hocam...

1. Kod ve 2. Kod Range("A7:A" & sonSatir).ClearContents kısmında hata veriyor. Range("A7" & sonSatir).ClearContents olarak düzeltince de en son satırdaki bilgileri siliyor