Ardışık olan boş sütunları silmek

[Believing]

Sayın Uzman arkadaşlar,

Aşağıdaki alıntı kod yardımı ile kapalı çalışma kitabının "A1:BO999" aralığından açık olan çalışma kitabına veri alıyorum.
"A1:BO999" aralığındaki veriler üçüncü satır dahil birer ardışık boş sütunlar bulunmaktadır.
Yapmak istediğim ama, bir türlü yapmayı başaramadığım senaryo konusunda yardımlarınızı almak durumundayım.
Önce kapalı kitabın "A1:BO999" aralığındaki boş sütunlarını silerek kaydetmek, sonrasında ise oluşan yeni tabloyu açık çalışma kitabıma transferini sağlamak için mevcut kodu nasıl revize etmeliyim?
Benim için çok kıymetli olan uzman yardımlarınızı rica ediyorum.

Saygılarımla,

Sub Database_Verilerini_Guncelle()

On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    With Sayfa8
        .Range("A1:BO199").ClearContents
        Dim Con As Object, rs As Object, Sorgu As String
    Set Con = CreateObject("Adodb.Connection")
    Set rs = CreateObject("Adodb.RecordSet")
    Set sf2 = Workbooks(dsy).Sheets("Sheet1")
        Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\Database_P4708.xls" & ";extended properties=""excel 12.0;hdr=no"""
        rs.Open "Select * from [Sheet1$A1:BO199]", Con, 1, 1
        Sheets("DATA_P4708").Range("A65536").End(3)(3, 1).CopyFromRecordset rs
        rs.Close: Con.Close
End With
    Sayfa8.Select
    Set Con = Nothing: Set rs = Nothing: Sorgu = ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[ÖmerFaruk]

Şöyle bir yol göstereyim.
Verileri bu şekilde aldıktan sonra silinecek sütunları mevcut dosyanıza silip tekrar kapalı dosyaya kopyalayarak kapalı dosyayı kaydedebilirsiniz.