Sayfa biçimini koruyarak kapalı çalışma kitabından veri almak

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.

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
Örnek Çalışma;
 

Ekli dosyalar

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 arkadaşlar,

Konu güncel olup, nasıl yapıldığı ile ilgili kısa bir anlatım da olursa çok makbule geçecektir.

Saygılarımla.
 
Üst