Kapalı dosyaya veri kaydetme

[ThEeNCi]

Merhaba,
Veri dosyasından kapalı dosyaya en dolu olan satırın altına veri kaydetme de yardımcı olabilir misiniz.
Açıklama dosya içinde yaptım.

Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Dosyanız kapalıyken bu veri kaydını yapmayı düşünüyorsanız dosyanızı formüllerden arındırmalısınız.

Bu haliyle dosyayı açıp veri aktarıldıktan sonra dosya kaydedilip kapatılarak veri aktarımı yapılabilir.

 

[ThEeNCi]

Peki aktarım yaptıktan sonra formül ekleme macrosu yapabilir miyiz.

 

[ThEeNCi]

Yada J hücresine kadar olan kısmı aktarabilirsek oda yetebilir.

 

[Korhan Ayhan]

Kapalı dosyaya veri kayıt işleminde dosya açılmadan kayıt yapılacaksa dosyanın boş bir veritabanı gibi olması gerekir. Yoksa hep sorun çıkacaktır.

Bunun yerine dosya açılıp veri aktarımı istediğiniz şekilde yapılabilir.

 

[ThEeNCi]

Tamam dosya açılıp veri aktarımı yapalım.

 

[ThEeNCi]

Korhan Bey Bu arada dosya ağdaki bilgisayarda.

 

[Korhan Ayhan]

Kod içindeki YOL bölümüne dosyanızın bulunduğu adresi yazıp deneyiniz.

Option Explicit

Sub Verileri_Aktar()
    Dim Yol As String, XL_App As Object, S1 As Worksheet, Zaman As Double
    Dim K2 As Workbook, S2 As Worksheet, Satir As Long, Son As Long
      
    Zaman = Timer
  
    Set S1 = Sheets("Sayfa1")
      
    Yol = ThisWorkbook.Path & "\KAPALI DOSYA.xlsx"

    Set XL_App = CreateObject("Excel.Application")

    XL_App.Visible = False
    Set K2 = XL_App.Workbooks.Open(Yol)
    
    Set S2 = K2.Sheets("Sayfa1")

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    Satir = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
    
    S2.Range("A" & Satir).Resize(Son - 4, 4).Value = S1.Range("A5:D" & Son).Value
    S2.Range("G" & Satir).Resize(Son - 4, 2).Value = S1.Range("G5:H" & Son).Value
    S2.Range("J" & Satir).Resize(Son - 4, 1).Value = S1.Range("J5:J" & Son).Value
    S2.Range("N" & Satir).Resize(Son - 4, 1).Value = S1.Range("N5:N" & Son).Value
    
    K2.Close True
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set K2 = Nothing
    Set XL_App = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[ThEeNCi]

Korhan Bey çok teşekkür ederim. Ellerinize sağlık.