verileri başka dosyaya aktarma

[incsoft]

Arkadaşlar ekteki dosyam datalara göre değişmekte ve bunları başka bir program aracılığıyla import edip kullandığımdan dolayı burada sadece dolu verilere ihtiyacım vardır. Mesela ekte örneğini verdiğim dosyamda o gün için =A1:J190 aralığı dolu olduğundan o alandaki tüm verileri örneğin buton aracılığıyla birebir D:\DATA.XLSX dosyasına aktarmak istiyorum. Bunun için sizlerin yardımlarına ihtiyacım vardır.

 

[incsoft]

yardımcı olacak arkadaşlar yokmudur?

 

[NBATMAN]

Merhaba,

linkte bir exe var. Onu bir deneyin. Belki işinize yarar.

http://s2.dosya.tc/server6/4c0lue/EXCELtoDatabase.rar.html

Bu EXE de;

"Excel Dosya Aç" butonu ile orjinal dosyanızı açın.
"Sayfa Adı" açılır kutusundan işlem yapacağınız sayfanın ismini seçiniz.
"Tabloya Al" butonu ile sayfadaki verileri programa alınız.
"KAYDET" butonu ile tabloyu yeni bir excel kitabı olarak kaydediniz.

 

[incsoft]

Merhaba,

linkte bir exe var. Onu bir deneyin. Belki işinize yarar.

http://s2.dosya.tc/server6/4c0lue/EXCELtoDatabase.rar.html

Bu EXE de;

"Excel Dosya Aç" butonu ile orjinal dosyanızı açın.
"Sayfa Adı" açılır kutusundan işlem yapacağınız sayfanın ismini seçiniz.
"Tabloya Al" butonu ile sayfadaki verileri programa alınız.
"KAYDET" butonu ile tabloyu yeni bir excel kitabı olarak kaydediniz.

 

[incsoft]

bu hata nedendir hocam?

 

[Korhan Ayhan]

DATA dosyasına aktarım yapılırken veriler sürekli alt alta mı aktarılacak? Yoksa eski veriler silinip yeni veriler mi aktarılacak?

 

[incsoft]

DATA dosyasına aktarım yapılırken veriler sürekli alt alta mı aktarılacak? Yoksa eski veriler silinip yeni veriler mi aktarılacak?

Eskiler silinecek hocam. Çünkü ben bu verileri sürekli başka bir programa import edeceğim..

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim K1 As Workbook, Link As Variant, Bul As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets("Sheet1").Copy
    Set K1 = ActiveWorkbook
    
    If Not IsEmpty(K1.LinkSources(xlExcelLinks)) Then
        For Each Link In K1.LinkSources(xlExcelLinks)
            K1.BreakLink Link, xlLinkTypeExcelLinks
        Next
    End If
    
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Delete
    Bul = Evaluate("=MATCH(TRUE,ISERROR(C:C),0)")
    Range("A" & Bul & ":A" & Rows.Count).EntireRow.Delete
    K1.SaveAs "D:\DATA.xlsx", 51
    K1.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[incsoft]

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim K1 As Workbook, Link As Variant, Bul As Long
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Sheets("Sheet1").Copy
    Set K1 = ActiveWorkbook
   
    If Not IsEmpty(K1.LinkSources(xlExcelLinks)) Then
        For Each Link In K1.LinkSources(xlExcelLinks)
            K1.BreakLink Link, xlLinkTypeExcelLinks
        Next
    End If
   
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Delete
    Bul = Evaluate("=MATCH(TRUE,ISERROR(C:C),0)")
    Range("A" & Bul & ":A" & Rows.Count).EntireRow.Delete
    K1.SaveAs "D:\DATA.xlsx", 51
    K1.Close
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Kodunuz güzel teşekkürler hocam ancak bütün alanları kaydediyor. Sadece dolu olan alanları atması için hangi kodu değiştirmem gereklidir?

 

[Korhan Ayhan]

Eklediğiniz dosyada deneme yaptığımda 190. satıra kadar olan veriler dosya olarak kayıt edildi. Sizde farklı bir durum mu oluşuyor?