tüm sayfalara sıra numarası vermek

[86126]

Arkadaşlar Kolay gelsin herkese merhaba;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long, No As Long

If Intersect(Target, Range("B4:B65536")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

For X = 4 To Selection.SpecialCells(xlCellTypeLastCell).Row
If Cells(X, "A").MergeArea.Count = 1 Then
If Cells(X, "B") <> "" And Cells(X, "A") <> "Sıra No" Then
No = No + 1
Cells(X, "A") = No
Else
If Cells(X, "A") <> "Sıra No" Then
Cells(X, "A").ClearContents
End If
End If
End If
Next

Application.ScreenUpdating = True
End Sub




bu koda göre her sayfaya nasıl otomatik sıra numarası verdiririz. Bu kod bulunduğu sayfaya veriyor.

 

[Ömer]

Merhaba,

Kod başlığını;

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

bu şekilde değiştirerek kodları sayfaların kod bölümüne değil, sadece ThisWorbook sayfasına kopyalayınız.

.

 

[86126]

çok teşekkür ederim. Beyninize sağlık.