Soru Eşitlik Sağlananları Aktar

[sirkülasyon]

Ustam
Ekli dosyamın ARŞİV sayfası B2:V Aralığında yer alan bilgileri Userformda ki;
Textbox1 ARŞİV sayfası V sütununda ki bilgilere
Listbox1, ARŞİV sayfası C sütununda ki bilgilere
Listbox2, ARŞİV sayfası D sütununda ki bilgilere
Listbox3, ARŞİV sayfası E sütununda ki bilgilere eşit olanları
ARŞİV sayfasında AA2:AU aralığını önce temizleyecek ve 2. satırdan itibaren aktaracak. Rica etsem yardımcı olabilir misiniz?

 

[YUSUF44]

Userforma bir commandbutton ekleyip aşağıdaki kodları deneyin:

Private Sub CommandButton1_Click()
Set s1 = Sheets("ARŞİV")
sonB = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

sonAA = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "AA").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [ARŞİV$B1:V" & sonB & "] where [Ödeme Yapılan Dönem Aralığı]='" & TextBox1.Text & _
        "' and [Yüklenici Adı Soyadı]='" & ListBox1.Value & "' and [Taşımacı Adı Soyadı]='" & ListBox2.Value & _
        "' and [Taşıma Yapılan Mahalle (Güzergâh ) Adı]='" & ListBox3.Value & "'"
Set rs = con.Execute(sorgu)
If sonAA > 1 Then s1.Range("AA2:AU" & sonAA).ClearContents
s1.[AA2].CopyFromRecordset rs

End Sub

 

[sirkülasyon]

Yusuf Abi Ellerine Sağlık Teşekkür Ederim