Otomatik numara verme

[excelience]

MERHABA ÖNCELİKLE HERKESİN BAYRAMINI EN İÇTEN DİLEKLERİMLE KUTLARIM.ELİMDE BÖYLE BİR KOD VAR

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "B") = Format(Now, "dd")
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "MMMM")
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "yyyy")
End Sub

BU KODA EK OLARAK F5:f65536 VERİ GİRDKİCE A5 TEN BAŞLARAYARAK A65536 ARASINA HER HUCRE İCİN FARKLI SIRA NO EKLEMEK İSTİYORUM 1 2 3 4 ....
DİYE
ŞİMDİDEN EMEKELERİNİZ İÇİN TEŞEKKÜR EDERİM

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "B") = Format(Now, "dd")
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "mmmm")
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "yyyy")
    If Not Intersect(Target, Range("F5:F65536")) Is Nothing Then
        If Target = Empty Then
            Cells(Target.Row, "A").ClearContents
        Else
            Cells(Target.Row, "A") = WorksheetFunction.Max(Range("A5:A65536")) + 1
        End If
    End If
End Sub

 

[çıtır]

Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("F5:F10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -5) = ""
Target.Offset(0, -4) = ""
Target.Offset(0, -3) = ""
Target.Offset(0, -2) = ""
Else
Target.Offset(0, -5) = WorksheetFunction.Max(Range("a2:a10000")) + 1
Target.Offset(0, -4) = Format(Now, "dd")
Target.Offset(0, -3) = Format(Now, "MMMM")
Target.Offset(0, -2) = Format(Now, "yyyy")
End If
End Sub

 

[excelience]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "B") = Format(Now, "dd")
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "mmmm")
    If Not Intersect(Target, Range("F1:F65536")) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "yyyy")
    If Not Intersect(Target, Range("F5:F65536")) Is Nothing Then
        If Target = Empty Then
            Cells(Target.Row, "A").ClearContents
        Else
            Cells(Target.Row, "A") = WorksheetFunction.Max(Range("A5:A65536")) + 1
        End If
    End If
End Sub

HOCAM SUPERMAN GİBİSİNİZ ANINDA İMDADA YETİSİYORSUNUZ COK TESEKKUR EDERİM :hihoho::hihoho::hihoho::hihoho:

 

[excelience]

Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("F5:F10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -5) = ""
Target.Offset(0, -4) = ""
Target.Offset(0, -3) = ""
Target.Offset(0, -2) = ""
Else
Target.Offset(0, -5) = WorksheetFunction.Max(Range("a2:a10000")) + 1
Target.Offset(0, -4) = Format(Now, "dd")
Target.Offset(0, -3) = Format(Now, "MMMM")
Target.Offset(0, -2) = Format(Now, "yyyy")
End If
End Sub

HOCAM COK TESSEKKUR EDERİM :bravo::bravo::bravo::bravo::bravo: