kod birlestirme

[dennisf06]

merhaba

sayin ustalarim asagidaki kodlardan 1.2.3.4. kodlari sayfanin kod bölümüne yazmak suretiyle textbox larda süzme islemi yapiyordum. taki 5. kodu ayni sayfaya yazana kadar bir sorun yoktu. 5.kod calisirsa texboxt kodlari sonradan calismiyor. acaba bu kodlari birlestirme imkani var midir acaba. yardimlariniz icin simdiden tesekkür ederim. saygilarimla...

1. Kod
Private Sub TextBox1_Change()
On Error Resume Next
TARÝH = TextBox1.Value = CDate(TextBox1.Value)
Set FC2 = Range("A4:A65000").Find(What:=TARÝH)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=1, Criteria1:=CDate(TextBox1.Value)
If TARÝH = "" Then
Selection.AutoFilter Field:=1
End If
End Sub

2.Kod
Private Sub TextBox2_Change()
On Error Resume Next
NO = TextBox2.Value
Set FC2 = Range("B4:B65000").Find(What:=NO)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=2, Criteria1:=TextBox2.Value
If NO = "" Then
Selection.AutoFilter Field:=2
End If
End Sub

3.Kod
Private Sub TextBox3_Change()
On Error Resume Next
METÝN2 = TextBox3.Value
Set FC2 = Range("C4:C65000").Find(What:=METÝN2)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=3, Criteria1:=TextBox3.Value & "*"
If METÝN2 = "" Then
Selection.AutoFilter Field:=3
End If
End Sub

4.Kod
Private Sub TextBox5_Change()
On Error Resume Next
METÝN2 = TextBox5.Value
Set FC2 = Range("E4:E65000").Find(What:=METÝN2)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=5, Criteria1:=TextBox5.Value & "*"
If METÝN2 = "" Then
Selection.AutoFilter Field:=5
End If
End Sub

5.Kod
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Set s2 = Sheets("Sayfa3")

If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -1).Interior.ColorIndex = xlNone
Exit Sub
End If

Set Bul = s2.Columns("D").Find(Target.Offset(0, -1), lookat:=xlWhole)
If Bul Is Nothing Then
Target.Offset(0, -1).Interior.ColorIndex = 3
MsgBox Target.Offset(0, -1).Value & " Lieferschein numarasi ile Firmaya herhangi bir malzeme girisi olmamistir."
Exit Sub
End If

If Target = s2.Cells(Bul.Row, "E") Then
Target.Offset(0, -1).Interior.ColorIndex = xlNone
Exit Sub
End If

Adr = Bul.Address
Do
Set Bul = s2.Columns("D").FindNext(After:=Bul)
If Target = s2.Cells(Bul.Row, "E") Then
Target.Offset(0, -1).Interior.ColorIndex = xlNone
Exit Sub
End If
Loop While Not Bul Is Nothing And Bul.Address <> Adr

If Target <> s2.Cells(Bul.Row, "E") Then
Target.Offset(0, -1).Interior.ColorIndex = 3
MsgBox "Dikkat!!! Malzemeye ait Liferschein numarasi yanlis.Kontrol edin lütfen."
Else
Target.Offset(0, -1).Interior.ColorIndex = xlNone
End If

Son:
End Sub