Soru Kapalı Dosyadaki Verileri Güncelleme

[metin_0606]

Değerli uzman arkadaşlar. Açık Kitap ve Kapalı isminde iki adet çalışma kitabım bulunmaktadır.( Açık kitap masaüstünde,Kapalı kitap ise masaüstündeki Data isimli klasörünün içinde bulunmaktadır) Açık Kitap isimli çalışmamdaki userform üzerinde bulunan textboxlara ben makro yardımı ile verileri alabiliyorum. Buraya kadar sıkıntı yok. Yapmak istediğim Textboxlara gelen verilerin herhangi birinde değişiklik yapıp güncelle dediğimde ilgili TC kimlik numaralı veriyi Kapalı çalışma kitabında bulup istenen gerekli değişikliği yapabilmek. Veriler Etkin ve İşten Ayrıldı olarak mükerrer kayıtlar içerebilmektedir. Yani aynı kişi birden fazla işe giriş çıkış yapabilmektedir. Ben Etkin yazan mükerrer kayıtta verileri güncellemek istiyorum. Kapalı isimli çalışma kitabımdaki veri satırı yaklaşık 7000 satırdan oluşmaktadır. Mevcut çalışmada textboxlara veriler gelmemekte, elle yazılmakta ben örnek olarak paylaştım sadece. Yardımlarınız için şimdiden teşekkürler.

 

[asi_kral]

Merhaba
Bu kodu güncelle butonuna ekleyip dener misiniz?

Private Sub CommandButton1_Click()
Dim KTP1 As Workbook, S1 As Worksheet, STR As Long
Dim HCR As Range, DRS As Variant, YOL As String
YOL = ThisWorkbook.Path & "\DATA\KAPALI.xlsx"
Set KTP1 = Workbooks.Open(YOL)
Set S1 = KTP1.Sheets("ANA SAYFA")
With S1.Range("B:B")
Set HCR = .Find(TextBox2, , LookIn:=xlValues, LookAt:=xlWhole)
If Not HCR Is Nothing Then
DRS = HCR.Address
Do
If WorksheetFunction.Proper(S1.Cells(HCR.Row, "E")) = "Etkin" Then
S1.Cells(HCR.Row, "A") = TextBox1: S1.Cells(HCR.Row, "B") = TextBox2
S1.Cells(HCR.Row, "C") = TextBox3: S1.Cells(HCR.Row, "D") = TextBox4
S1.Cells(HCR.Row, "E") = TextBox5
End If
Set HCR = .FindNext(HCR)
Loop While Not HCR Is Nothing And HCR.Address <> DRS
End If
End With
KTP1.Save: KTP1.Close
End Sub

 

[metin_0606]

Merhaba
Bu kodu güncelle butonuna ekleyip dener misiniz?

Private Sub CommandButton1_Click()
Dim KTP1 As Workbook, S1 As Worksheet, STR As Long
Dim HCR As Range, DRS As Variant, YOL As String
YOL = ThisWorkbook.Path & "\DATA\KAPALI.xlsx"
Set KTP1 = Workbooks.Open(YOL)
Set S1 = KTP1.Sheets("ANA SAYFA")
With S1.Range("B:B")
Set HCR = .Find(TextBox2, , LookIn:=xlValues, LookAt:=xlWhole)
If Not HCR Is Nothing Then
DRS = HCR.Address
Do
If WorksheetFunction.Proper(S1.Cells(HCR.Row, "E")) = "Etkin" Then
S1.Cells(HCR.Row, "A") = TextBox1: S1.Cells(HCR.Row, "B") = TextBox2
S1.Cells(HCR.Row, "C") = TextBox3: S1.Cells(HCR.Row, "D") = TextBox4
S1.Cells(HCR.Row, "E") = TextBox5
End If
Set HCR = .FindNext(HCR)
Loop While Not HCR Is Nothing And HCR.Address <> DRS
End If
End With
KTP1.Save: KTP1.Close
End Sub

Teşekkürler Asi kıral örnek dosyamda istediğim sonucu oldum