Sıra no verme hücre değişikliğinde

[mukoli]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [H2:H1000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False

If Target.Value = "AYRILDI" Then
cevap = MsgBox("KAYIT TAŞINAÇAK.ONAYLIYOR MUSUNUZ ?", vbYesNo + vbQuestion, "UYARI", 500, 50) = vbNo

If cevap = True Then
Target.Value = ""
MsgBox "İŞLEM İPTAL EDİLDİ,YENİDEN DURUM BELİRLEYİNİZ", vbInformation
 
   
   
   Exit Sub
    End If
    a = Target.Row: Son = Sheets("İşten Ayrılanlar").Cells(65355, "A").End(3).Row + 1
Sheets("İşten Ayrılanlar").Range("B" & Son) = ActiveSheet.Range("B" & a)
Sheets("İşten Ayrılanlar").Range("C" & Son) = ActiveSheet.Range("C" & a)
Sheets("İşten Ayrılanlar").Range("D" & Son) = ActiveSheet.Range("D" & a)
Sheets("İşten Ayrılanlar").Range("E" & Son) = ActiveSheet.Range("E" & a)
Sheets("İşten Ayrılanlar").Range("F" & Son) = ActiveSheet.Range("F" & a)
Sheets("İşten Ayrılanlar").Range("G" & Son) = ActiveSheet.Range("G" & a)
Sheets("İşten Ayrılanlar").Range("H" & Son) = ActiveSheet.Range("H" & a)
Sheets("İşten Ayrılanlar").Range("A2:A600").ClearContents
For t = 2 To Son
If Not Sheets("İşten Ayrılanlar").Cells(t, 2) = "" Then
sr = sr + 1
Sheets("İşten Ayrılanlar").Cells(t, 1) = sr
End If
Next t
Sheets("İşten Ayrılanlar").Range("A2" & ":" & "H" & Son).Borders.LineStyle = xlContinuous

ActiveSheet.Rows(a).Delete
ActiveSheet.Range("A2:A600").ClearContents
son1 = ActiveSheet.Cells(65355, "B").End(3).Row + 1
For s = 2 To son1
If Not ActiveSheet.Cells(s, 2) = "" Then
Nr = Nr + 1
ActiveSheet.Cells(s, 1) = Nr
End If
Next s
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM"
End If

End Sub

Merhaba bu kod B alanıına veri girildiğinde otomatik A sütununda sıra numarası nasıl verdirebiliriz.Satır silindiğinde sırayı otomatik düzeltmesi lazım İyi günler dilerim herkese

 

[ÖmerFaruk]

İşten Ayrılanlarlar sayfasında mı olacak bu düzenleme işi?

 

[mukoli]

İşten Ayrılanlarlar sayfasında mı olacak bu düzenleme işi?

Hayır hocam aktif sayfada olucak

 

[ÖmerFaruk]

For s = 2 To son1
    If Not ActiveSheet.Cells(s, 2) = "" Then
        Nr = Nr + 1
        ActiveSheet.Cells(s, 1) = Nr
    End If
Next s

Kodunuzun bu kısmı o işi yapmıyor mu?

 

[mukoli]

For s = 2 To son1
    If Not ActiveSheet.Cells(s, 2) = "" Then
        Nr = Nr + 1
        ActiveSheet.Cells(s, 1) = Nr
    End If
Next s

Kodunuzun bu kısmı o işi yapmıyor mu?

O kod satır silindiğinde Yapıyor hocam ben yeni veri eklediğimde yapmıyor

 

[ÖmerFaruk]

ActiveSheet ile ilgili yeni veri eklediğiniz kdo satırını ben göremiyorum.

 

[mukoli]

ActiveSheet ile ilgili yeni veri eklediğiniz kdo satırını ben göremiyorum.

Benimde yapmak istediğim o yapamadım hocam koda ekleme yapmak istiyorum . Mesela b alanına veri ekledim sıra no 5 ise 6 yazması

 

[ÖmerFaruk]

Ben anlayamadım. Kusura bakmayın.

 

[mukoli]

Hocam şöyle anlatayım bu kodu yukardaki koda entegre edebilirmiyiz

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:C201]) Is Nothing Then Exit Sub
Dim i As Long, sr As Long
[a2:a65536].ClearContents
For i = 2 To [B201:C201].End(3).Row
If Not Cells(i, 2) = "" And Not Cells(i, 3) = "" Then
sr = sr + 1
Cells(i, 1) = sr
End If
Next
End Sub