İsme göre sayfa açmada veri problemi

[byfika]

Merhabalar, sayfadan isimlere göre sayfa açılınca, aynı isme ait olan farklı satırlardaki girilen son sütuna kadar aynı olan verinin aynı isme açılan sayfaya, satırdaki verinin aynısın olduğu ikazını yapıp kayıt onayı alıp nasıl kayıt yapılabilinir. Bilgi için şimdiden teşekkürler.

 

[Korhan Ayhan]

"gönder" isimli makronuzu aşağıdaki gibi değiştirip deneyiniz.

Not : Foruma dosya eklerken şifreli olmamasına özen gösteriniz.

Sub Gönder()
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Call sayfaları_oluştur
    Set s1 = ThisWorkbook.Worksheets("VERİ")
    
    For i = 3 To s1.Range("b65536").End(xlUp).Row
        Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 2).Value)
        
        aranan = Empty
        
        For x = 2 To 53
            aranan = aranan & s1.Cells(i, x)
        Next
        
        Kontrol = WorksheetFunction.CountIf(s2.Range("a2:a65536"), aranan)
        If Kontrol > 0 Then
            Onay = MsgBox("Mükerrer kayıt tespit edildi!" & Chr(10) & Chr(10) & "Mükerrer kayıt ilgili sayfaya aktarılsın mı?", vbExclamation + vbYesNo)
        End If
        
        If Kontrol = 0 Or Onay = vbYes Then
            sonsatir = s2.Range("b65536").End(xlUp).Row + 1
            s2.Cells(sonsatir, 1) = aranan
            s2.Cells(sonsatir, 2) = sonsatir - 1
            For y = 3 To 55
                s2.Cells(sonsatir, y) = s1.Cells(i, y - 1)
            Next
            Say = Say + 1
        End If
    Next
    
    Application.ScreenUpdating = True
    
    If Say >= 1 Then MsgBox Say & " VERİ İSİM SAYFASINA KAYDEDİLDİ.", vbInformation
    If Say = 0 Then MsgBox " Yazılacak veri BULUNAMADI.", vbCritical, "U Y A R I"
End Sub

 

[byfika]

Korhan Ayhan bey, VBA şifresi için kusura bakmayın orjinal sayfadan uyarlama yaparken gözümden kaçmış. yazdığınız makro çalışıyor, çok teşekkür ederim. Hakkınızı helal edin.