Believing
Altın Üye
- Katılım
- 19 Mayıs 2013
- Mesajlar
- 700
- Excel Vers. ve Dili
-
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
- Altın Üyelik Bitiş Tarihi
- 23-08-2028
Sayın uzman arkadaşlar,
Ekteki çalışmada kapalı çalışma kitabından "VERİTABANI" isimli sayfaya veri alıyorum. Bu işlemi yaparken "VERİTABANI" sayfasının tüm biçimlendirmelerini korumak için aşağıdaki kodu nasıl revize etmeliyim?
Saygılarımla.
Örnek Çalışma;
Ekteki çalışmada kapalı çalışma kitabından "VERİTABANI" isimli sayfaya veri alıyorum. Bu işlemi yaparken "VERİTABANI" sayfasının tüm biçimlendirmelerini korumak için aşağıdaki kodu nasıl revize etmeliyim?
Saygılarımla.
Kod:
Sub Completed_Sayfasından_Al()
Dim con As Object
Dim rs As Object
Sheets("VERİTABANI").Select
Range("F3:Z65536").Value = ""
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\Database_CLOSED.xlsx" & _
";extended properties=""excel 8.0;hdr=No"""
Sql = "select F1,F2,F3,F4,F5,F6,F7,F8,F12,F13,F14,F9,F10,F11,F15,F16,F17,F18,F19,F20,F21 from [Sheet$A1:U65536] " & _
"where f4 is not null And Format(F4,'yyyy.MM.dd') Between '" & Format(Range("H1").Value, "yyyy.MM.dd") & "' And '" & Format(Range("I1").Value, "yyyy.MM.dd") & "'"
Set rs = con.Execute(Sql)
Range("F65536").End(3).Offset(1, 0).Cells.CopyFromRecordset rs
If rs.RecordCount > 0 Then
NoA = Range("F" & Rows.Count).End(xlUp).Row + 1
Range("F" & F).CopyFromRecordset rs
End If
Set rs = Nothing
Set con = Nothing
Range("F3:Z65536").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21), Header:=xlYes
MsgBox "VERİLERİNİZ GÜNCELLENMİŞTİR.", vbInformation
Sheets("SETTINGS").Select
Range("B2").Select
End Sub
Ekli dosyalar
-
388 KB Görüntüleme: 5