Otomatik yazma

[burhancavus61]

Sayfa 1 D sütunun son satırına yazdığım ismi her defasında sayfa 2 nin D1 hücresine yazma. Sayfa1 d sütunun son satırına sürekli ekleme yapıyorum Her yeni kişi eklediğimde sayfa2 D1 hücresi makro ile nasıl değişir.

 

[Muzaffer Ali]

Merhaba.

Sayfa1 in kod kısımına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Long
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        SonSatir = Cells(Rows.Count, "D").End(xlUp).Row
        If Target.Row = SonSatir Then
            Worksheets("Sayfa2").Range("D2") = Target
        End If
    End If
End Sub

 

[burhancavus61]

Teşekkür ederim bir şey sorabilirmiyim.

 

[burhancavus61]

Aynı sayfada aşağıdaki kod var. sizin verdiğinizle nasıl birleştirebilirim.

Private Sub Worksheet_Change(ByVal Target As Range)

   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("D:G")) Is Nothing Then Exit Sub
   satir = Target.Row
   sutun = Target.Column
 
   sonsatira = Cells(Rows.Count, "D").End(3).Row
   sonsatirb = Cells(Rows.Count, "G").End(3).Row
   If sonsatira > sonsatirb Then SonSatir = sonsatira Else SonSatir = sonsatirb
   Say = 0
   For i = 1 To SonSatir
     veria = Cells(i, "D").Value
     verib = Cells(i, "G").Value
     If veria = Cells(satir, "D").Value And verib = Cells(satir, "G").Value Then Say = Say + 1
   Next i
   If Say > 1 Then
    MsgBox (veria & " ve " & verib & " Mükerrer girildi.")
    
    Application.EnableEvents = False
     Cells(satir, "D").Value = ""
     Cells(satir, "G").Value = ""
    Application.EnableEvents = True

   End If

 

[EmrExcel16]

Merhaba ,

Şu kodlardan sonrasına aşağıdaki kodları ekleyip deneyiniz.sonsatirb = Cells(Rows.Count, "G").End(3).Row

   If Target.Column = 4 Then
        If Target.Row = sonsatira Then
            Worksheets("Sayfa2").Range("D2") = Target
        End If
   End If

 

[burhancavus61]

hata veriyor

 

[burhancavus61]

bu iki kod bağımsız çalışıyor ama birleştiremiyorum

Private Sub Worksheet_Change(ByVal Target As Range)

   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("D:G")) Is Nothing Then Exit Sub
   satir = Target.Row
   sutun = Target.Column
 
   sonsatira = Cells(Rows.Count, "D").End(3).Row
   sonsatirb = Cells(Rows.Count, "G").End(3).Row
    
   If sonsatira > sonsatirb Then SonSatir = sonsatira Else SonSatir = sonsatirb
   Say = 0
   For i = 1 To SonSatir
     veria = Cells(i, "D").Value
     verib = Cells(i, "G").Value
     If veria = Cells(satir, "D").Value And verib = Cells(satir, "G").Value Then Say = Say + 1
   Next i
   If Say > 1 Then
    MsgBox (veria & " ve " & verib & " Mükerrer girildi.")
    
    Application.EnableEvents = False
     Cells(satir, "D").Value = ""
     Cells(satir, "G").Value = ""
    Application.EnableEvents = True

   End If
  
End Sub

ve

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Long
   If Not Intersect(Target, Range("D:D")) Is Nothing Then
        SonSatir = Cells(Rows.Count, "D").End(xlUp).Row
        If Target.Row = SonSatir Then
            Worksheets("Rapor-Kişi").Range("D2") = Target
        End If
    End If
End Sub

 

[EmrExcel16]

Hangi satırda hata veriyor ?

 

[burhancavus61]

Worksheets("Sayfa2").Range("D2") = Target

Sayfa adı Rapor-Kişi aslında ama her ikisindede hata verdi

 

[EmrExcel16]

Bu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("D:G")) Is Nothing Then Exit Sub
   satir = Target.Row
   sutun = Target.Column
 
   sonsatira = Cells(Rows.Count, "D").End(3).Row
   sonsatirb = Cells(Rows.Count, "G").End(3).Row
    
    If Target.Column = 4 Then
        If Target.Row = sonsatira Then
            Worksheets("Rapor-Kişi").Range("D2") = Target
        End If
    End If
    
   If sonsatira > sonsatirb Then SonSatir = sonsatira Else SonSatir = sonsatirb
   Say = 0
   For i = 1 To SonSatir
     veria = Cells(i, "D").Value
     verib = Cells(i, "G").Value
     If veria = Cells(satir, "D").Value And verib = Cells(satir, "G").Value Then Say = Say + 1
   Next i
   If Say > 1 Then
    MsgBox (veria & " ve " & verib & " Mükerrer girildi.")
    
    Application.EnableEvents = False
     Cells(satir, "D").Value = ""
     Cells(satir, "G").Value = ""
    Application.EnableEvents = True

   End If
 
End Sub

 

[burhancavus61]

Aynı yerde hata veriyor

Worksheets("Rapor-Kişi").Range("D2") = Target

 

[EmrExcel16]

Dosyanızı ekleyebilir misiniz ?

 

[burhancavus61]

Boyutu büyük sadeleştirmem lazım. Birde kişilerin tc kimlik bilgileri var. Müsait bi zamanda yükleyeyim. Aslında kodlar ayrı ayrı çalışıyor. Bende bu arada biraz uğraşayım.

 

[EmrExcel16]

Bu dosyada dener misiniz ?

 

[burhancavus61]

Kusura bakmayın sorun çözüldü. Ben hata yapıyormuşum. Kilitli hücreye veri girmeye çalıştığından hata verdi. Düzelttim teşekkür ederim.

 

[EmrExcel16]

Kusura bakmayın sorun çözüldü. Ben hata yapıyormuşum. Kilitli hücreye veri girmeye çalıştığından hata verdi. Düzelttim teşekkür ederim.

Rica ederim , iyi çalışmalar.