tahsinanarat
Altın Üye
- Katılım
- 14 Mart 2005
- Mesajlar
- 2,164
- Excel Vers. ve Dili
- Ofis 2019 Türkçe
- Altın Üyelik Bitiş Tarihi
- 27-05-2028
Kod:
Sub Talep_olusturma_Guncelle()
Sheets("veri").Select
Range("A6:N65000").ClearContents
Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
Dosya = application.GetOpenFilename(filefilter:="EXCEL belgeler(*.xls*),(*.xls*)", _
Title:="KAYNAK EXCEL belgesini seçiniz.")
If Dosya = Empty Then Exit Sub
con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
Dosya & ";extended properties=""excel 12.0;hdr=no;imex=no"""
sorgu = "Select f1,f2,F3,F4,F5,F6,F7 from [Elbise$A2:J65536] WHERE f5 > 0"
rs.Open sorgu, con, 1, 1
Range("a6").CopyFromRecordset rs
rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: sorgu = Empty
ActiveSheet.Columns("A:N").EntireColumn.AutoFit
On Error Resume Next
Range("Z1") = 1
[A6:N65536].Sort Key1:=[A6]
Range("A5:N5").Font.Bold = True
End Sub