Soru Otomotik Sıra Numarası Verme

[TURKOLOG]

Herkese merhaba benim sorunum şu: Excelde userform üzerinden bir buton yardımı ile Sayfa1 deki sayfa2 deki sayfa3 deki B2 hücresinden B sütunundaki son dolu hücreye kadar A2 den başlamak sureti ile 1 den başlamak sureti ile sıra numara vermesini istiyorum. Sayfa1 Sayfa2 Sayfa3 diye devam edeceğim için sayfalara isim vermek yerine Sayfa1 Sayfa2 Sayfa3 diye makro kodu yazılması benim için daha pratik olur.

Private Sub CommandButton1_Click()
For x = 1 To Sheets.Count
sn = 1
son_satir = Sheets(x).Range("B" & Rows.Count).End(xlUp).Row
    For y = 2 To son_satir
        Sheets(x).Cells(y, "A") = sn
        sn = sn + 1
    Next y
Next x
End Sub

Bu kod exceldeki tüm sayfalara Sıra numarası veriyor. Ama benim yaklaşık 10 sayfam var ama 5 veya 6 sayfada sıra numarası verme işlemini uygulamak istiyorum. kodu tek buton yardimi ile misal Sayfa1,Sayfa2,sayfa3,Sayfa4,Sayfa5 diyip revize etmek için yardim lazim. Yanı tek butonla 10 sayfam var ama 5 sayfama A2 den itibaren B2 den son dolu b satırına bakarak satır numarası vermek istiyorum.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalara_Sira_No_Ver()
    Dim Sayfa As Variant, S1 As Worksheet, X As Byte, Son As Long
    
    Sayfa = Array("Sayfa1", "Sayfa2", "Sayfa3", "Sayfa4", "Sayfa5")
    
    For X = 0 To UBound(Sayfa)
        Set S1 = Sheets(Sayfa(X))
        If S1.Range("B2") <> "" Then
            S1.Range("A2") = 1
            Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
            If Son > 1 Then S1.Range("A2:A" & Son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
        End If
    Next
    
    MsgBox "Sıra numaraları güncellenmiştir.", vbInformation
End Sub

 

[TURKOLOG]

Deneyiniz.

Option Explicit

Sub Sayfalara_Sira_No_Ver()
    Dim Sayfa As Variant, S1 As Worksheet, X As Byte, Son As Long
   
    Sayfa = Array("Sayfa1", "Sayfa2", "Sayfa3", "Sayfa4", "Sayfa5")
   
    For X = 0 To UBound(Sayfa)
        Set S1 = Sheets(Sayfa(X))
        If S1.Range("B2") <> "" Then
            S1.Range("A2") = 1
            Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
            If Son > 1 Then S1.Range("A2:A" & Son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
        End If
    Next
   
    MsgBox "Sıra numaraları güncellenmiştir.", vbInformation
End Sub

Çok teşekkür ederim Sayın @Korhan Ayhan kod çalıştı. emeğinize sağlık.