ListBox Çoklu seçim kaydederken Sıra No sorunu

[Hakan ERDOST]

Private Sub CommandButton1_Click()
Sheets("GEZİ_LİSTESİ").Select
    With ListBox1
             For a = 0 To .ListCount - 1
            If .Selected(a) = True Then
                Range("B65536").End(3)(2, 1) = .List(a, 0)
                Range("C65536").End(3)(2, 1) = .List(a, 1)
                Range("D65536").End(3)(2, 1) = .List(a, 2)
                Range("E65536").End(3)(2, 1) = .List(a, 3)
            End If
        Next a
    End With
    a = Empty
End Sub


Private Sub UserForm_Initialize()
Sheets("VERİ").Select

    ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectMulti
    For i = 2 To Range("A65536").End(3).Row
        With ListBox1
            .ColumnCount = 37
            .AddItem Cells(i, 1)
            .List(.ListCount - 1, 1) = Cells(i, 2)
            .List(.ListCount - 1, 2) = Cells(i, 36)
            .List(.ListCount - 1, 3) = Cells(i, 37)
            
        End With
    Next i
    
    sütun = Cells(1, Columns.Count).End(1).Column
    For a = 1 To sütun
        s = s & CLng(Columns(a).Width) & ";"
    Next
    ListBox1.ColumnWidths = s
    
End Sub

Bu kodlar ile çoklu seçim yaparak liste oluşturuyorum. Ancak listemin sıra no sütunu ilk sütun yani toplu aktarımda da birer artıyor(Klasik kaydet makrosunda).Sıra noyu seçim kadar artırarak kaydetmek mümkün mü acaba?

aşağıdaki kod bir artırıyor

Son_Dolu_Satir = Sheets("GEZİ_LİSTESİ").Range("A65536").End(xlUp).Row
    Bos_Satir = Son_Dolu_Satir + 1
    Sheets("GEZİ_LİSTESİ").Range("A" & Bos_Satir).Value = _
                   Application.WorksheetFunction.Max(Sheets("GEZİ_LİSTESİ").Range("A:A")) + 1

 

[vardar07]

Kodda sorun görünmüyor. Sütundaki sayı sıralaması bir fazla olmasın. Yani bir sayı silinmişse bir fazla gösterir. Olmazsa kullandığınız formun olduğu dosyayı ekleyin.