Soyadını yazdıktan sonra otomatik alt satıra gecsin.

[istanbulcahan]

Soyadını yazdıktan sonra otomatik alt satıra gecsin ve otomatik sıra sayısı artsın. nasıl yapılır.

 

[Ömer BARAN]

Merhaba.

Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
Açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.

B, C ve D sütunundaki hücreler dolu ise E sütunundaki hücreye veri yazıp ENTER tuşuna basınca;
bir sonraki satır A sütununa numara verilirek B sütunundaki hücre aktif hale gelir.
.

[FONT="Arial Narrow"]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E9:E" & [E65536].End(3).Row)) Is Nothing Then Exit Sub
If WorksheetFunction.CountBlank(Range("A" & Target.Row & ":E" & Target.Row)) = 0 Then
    Cells(Target.Row + 1, 1) = Target.Row - 7: Cells(Target.Row + 1, 2).Activate: End If
End Sub[/FONT]

 

[istanbulcahan]

Olmadı entere basınca bir alta (E sutunun altına)geciyor, üstad.

 

[Ömer BARAN]

İşleme ilk başladığınızda A sütununa sıra numarasını elle yazın,
sonrakiler için kod tarafından yazılacak.

 

[istanbulcahan]

Merhaba.

Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
Açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.

B, C ve D sütunundaki hücreler dolu ise E sütunundaki hücreye veri yazıp ENTER tuşuna basınca;
bir sonraki satır A sütununa numara verilirek B sütunundaki hücre aktif hale gelir.
.

[FONT="Arial Narrow"]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E9:E" & [E65536].End(3).Row)) Is Nothing Then Exit Sub
If WorksheetFunction.CountBlank(Range("A" & Target.Row & ":E" & Target.Row)) = 0 Then
    Cells(Target.Row + 1, 1) = Target.Row - 7: Cells(Target.Row + 1, 2).Activate: End If
End Sub[/FONT]

Kod bölümünde script var. Verdiğiniz kodu bu durumda nasıl ekleyeceğim.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("d6:e32")) Is Nothing Then Exit Sub
Cancel = True
Application.ScreenUpdating = False
Application.Calculation = xlManual
adı = Trim(Cells(Target.Row, "d").Value)
soyadı = Trim(Cells(Target.Row, "e").Value)
Cells(Target.Row, "B").Value = ""
If adı = "" Then Exit Sub
If soyadı = "" Then Exit Sub
For r = 2 To Worksheets("BİLGİ GİRME").Cells(Rows.Count, "a").End(3).Row
bulunan1 = Trim(Sheets("BİLGİ GİRME").Cells(r, "a").Value)
bulunan2 = Trim(Sheets("BİLGİ GİRME").Cells(r, "b").Value)
If bulunan1 = adı And bulunan2 = soyadı Then
Cells(Target.Row, "b").Value = Sheets("BİLGİ GİRME").Cells(r, "c").Value
End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub