Dosyayı Excele Aktarma

[Utekiner]

Siz klasör mü seçmek istiyorsunuz yoksa tek bir dosya mı?

Hocam tek bir excel dosyası xls. xlsm. v.s.

 

[Korhan Ayhan]

Bu durumda klasör değil sadece o dosyayı seçerek aktarım yapmayı düşündüğünüzü anlıyorum. Doğru mudur?

Birde aktarımda biçimler formüller varsa bunlarda mı aktarılacak yoksa sadece değerler mi aktarılacak?

 

[Utekiner]

Bu durumda klasör değil sadece o dosyayı seçerek aktarım yapmayı düşündüğünüzü anlıyorum. Doğru mudur?

Birde aktarımda biçimler formüller varsa bunlarda mı aktarılacak yoksa sadece değerler mi aktarılacak?

Doğrudur Korhan Hocam,
kapalı olan dosyanın tüm haliyle formül mevcut ise formüller, biçimler, başlıklar,

 

[Korhan Ayhan]

Kapalı dosyada tek sayfamı aktif dosyaya aktarılacak yoksa içinde birden fazla sayfa mı mevcut?

Sayfa/ların adı belli mi?

 

[Utekiner]

Kapalı dosyada tek sayfamı aktif dosyaya aktarılacak yoksa içinde birden fazla sayfa mı mevcut?

Sayfa/ların adı belli mi?

Hocam birden fazla sayfa olabilir. Sayfa isimleri belli değil, Kapalı dosyada yazılı olan neyse o olmalı.

 

[Korhan Ayhan]

O zaman sayfaları (kaç sayfa varsa) taşı ve kopyala gibi bir sonuç istiyorsunuz anladığım kadarıyla...

 

[Utekiner]

O zaman sayfaları (kaç sayfa varsa) taşı ve kopyala gibi bir sonuç istiyorsunuz anladığım kadarıyla...

Evet Hocam.

 

[Korhan Ayhan]

Deneyiniz.

Sayfaları kodu çalıştırdığınız dosyaya yapar. Dosyanızda "Sayfa1" adında bir sayfa olmalıdır. Eğer sizin dosyanızda sayfa adı farklı ise kodu revize etmelisiniz. Aktarımdan önce dosyanızda ki "Sayfa1" dışındaki tüm sayfaları silerek işlem yapmaktadır.

Bu sebeple kodu önce boş bir dosyada denemenizi tavsiye ederim.

Option Explicit

Sub Export_Sheet_In_Selected_Excel_File()
    Dim Selected_File As Variant, Source_Wb As Workbook
    Dim Target_Wb As Workbook, Sh As Worksheet, Sheets_Count As Integer
   
    Application.ScreenUpdating = False
   
    Set Source_Wb = ThisWorkbook
   
    Application.DisplayAlerts = False
   
    For Each Sh In Source_Wb.Worksheets
        If Sh.Name <> "Sayfa1" Then Sh.Delete
    Next
   
    Application.DisplayAlerts = True
   
    Selected_File = Application.GetOpenFilename( _
                    Title:="Lütfen aktarmak istediğiniz excel dosyasını seçiniz...", _
                    FileFilter:="Excel Files (*.xls*),*xls*")
   
    If Selected_File <> False Then
        Set Target_Wb = GetObject(Selected_File)
       
        For Each Sh In Target_Wb.Worksheets
            Sheets_Count = Sheets_Count + 1
            Sh.Copy After:=Source_Wb.Sheets(Source_Wb.Worksheets.Count)
        Next
       
        Target_Wb.Close False
    End If

    Set Source_Wb = Nothing
    Set Target_Wb = Nothing

    Application.ScreenUpdating = True
   
    MsgBox "Sayfa aktarımı tamamlanmıştır." & vbCr & vbCr & _
           "Aktarılan sayfa sayısı ; " & Sheets_Count
End Sub

 

[Utekiner]

@Korhan Ayhan Hocam çok teşekkür ederim. Süper çalışıyor. Emek verdiğiniz için çok sağolun.

 

[1mak1mak]

@1mak1mak,

Aşağıdaki gibi yapabilirsiniz.

Sub Ado_Kapali()
    Dim Con As Object, Rs As Object, Sorgu As String
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
    Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & ThisWorkbook.Path & "\Gürmen Yatırım.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=no"""
    Sorgu = "Select * From [Sayfa1$M2:M2]"
    Rs.Open Sorgu, Con, 1, 1
    Range("A2").CopyFromRecordset Rs
    Rs.Close: Con.Close
    Sorgu = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

[/QUOTE]
Hocam Çok Teşekkür ederim güzel çalışıyor ellerinize sağlık.
Cevap vermek için arkadaşın çözümü ile ilgili yazıştığınızdan araya girmeyip sonuçlanmasını bekledim.
Bu Kod'a şöyle bir ilaveyi nasıl yaparız acaba.
Gene aynı klasörde bulunan başka bir kapalı dosyanın "\Gürmen Hesap.xlsx" Sayfa1 deki [F5] [G15] ve ve [AB3] hücrelerindeki
değerleri Gene aynı şekilde "Açık" Dosyasındaki [A3] [B4] ve [B6] Hücrelerine yani bu şekilde tercihe dayalı çoklu alma işlemi
için Üstteki Kod'da nasıl ilave yapmak gerekir. Üstteki Kod gene kalacak bu ilave olacak.
Şimdiden çok Teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

Sub Ado_Kapali()
    Dim Con As Object, Rs As Object, Sorgu As String
    
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
    
    Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\Gürmen Hesap.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select * From [Sayfa1$F5:F5]"
    Rs.Open Sorgu, Con, 1, 1
    Range("A3").CopyFromRecordset Rs
    Rs.Close
    
    Sorgu = "Select * From [Sayfa1$G15:G15]"
    Rs.Open Sorgu, Con, 1, 1
    Range("B4").CopyFromRecordset Rs
    Rs.Close

    Sorgu = "Select * From [Sayfa1$AB3:AB3]"
    Rs.Open Sorgu, Con, 1, 1
    Range("B6").CopyFromRecordset Rs
    Rs.Close

    Con.Close
    
    Sorgu = vbNullString
    Set Rs = Nothing
    Set Con = Nothing
End Sub

 

[1mak1mak]

Deneyiniz.

Sub Ado_Kapali()
    Dim Con As Object, Rs As Object, Sorgu As String
  
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
  
    Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\Gürmen Hesap.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
  
    Sorgu = "Select * From [Sayfa1$F5:F5]"
    Rs.Open Sorgu, Con, 1, 1
    Range("A3").CopyFromRecordset Rs
    Rs.Close
  
    Sorgu = "Select * From [Sayfa1$G15:G15]"
    Rs.Open Sorgu, Con, 1, 1
    Range("B4").CopyFromRecordset Rs
    Rs.Close

    Sorgu = "Select * From [Sayfa1$AB3:AB3]"
    Rs.Open Sorgu, Con, 1, 1
    Range("B6").CopyFromRecordset Rs
    Rs.Close

    Con.Close
  
    Sorgu = vbNullString
    Set Rs = Nothing
    Set Con = Nothing
End Sub

Hocam ellrinize sağlık çok Teşekkür ederim
İlk Kod'daki Dosyadan veriyi almadı onu da Kod'a o dosyayı da ilave ederek 2.ayrı dosyadan verileri kolayca aldım.

 

[1mak1mak]

Deneyiniz.

Hocam ellrinize sağlık çok Teşekkür ederim
İlk Kod'daki Dosyadan veriyi almadı onu da Kod'a o dosyayı da ilave ederek 2.ayrı dosyadan verileri kolayca aldım.

Hocam sadece anlamadığım bir şey var 2.dosyadan verileri alırken Kod larda hiçbir fark olmamasına rağmen
Kapalı dosyalardan bir tanesinin hiç Değiştirlme Tarih ve Saati değişmezken bir tanesinde değişiyor.
Acaba Kapalı Dosyalardan biri xls diğeri xlsx bundan dolayı olabilirmi. xls olanda değişiklik olmuyor
xlsx olanınki değişiyor sanki açılmış da kaydedilip çıkılmış gibi.

Bu Satırdaki kod ile ilgili olabilirmi?
";Extended Properties=""Excel 12.0;Hdr=No"""

 

[1mak1mak]

Hocam Tekrar merhaba sizi yoruyorum ama
Kapalı olan xlsx dosyasını inceledimde farkına varmıyordum ama şimdi dikkat edince dosyayı normalde de açıp hiçbir şey yapmadan kapattığımda
sürekli değişiklikler kaydedilsinmi uyarısıyla karşılaşıyordum gene aynı uyarı devam ediyor.
Neden acaba diye baktım sebep yok dosyada hiç Makro yok sadece Formüller var. Dikkatli incelediğimde sadece sayfaya eklediğim aktif olarak çalışan
=BUGÜN() Formülü var ve sanıyorum ki sayfayı her açtığımda belki Tarih değişmiyor ama bu Formül Saat ve Dakika vs.
bilgilerini de sürekli alıyorsa kapatırken bunu değişiklik olarak görüp değişiklikleri kaydetme uyarısı veriyor olabilir.
Bu yüzden yukarıdaki Makro ile verileri alıp çıkarken kaydedip çıkıyor olabilir.
Eğer böyleyse Acaba Makro'ya kapalı dosyadan verileri aldıktan sonra kaydetmeden çık diye bir satır eklenebilirmi.
Veya Dosyaya Sadece Tarih bilgisini alıp (Saat Dakika vs.) bilgisi almadan ekleyebileceğim bildiğiniz bir Formül varmı.
Yoksa da böyle idare edeceğim çok önemli değil sadece merak ettiğim ve sebebi bumudur diye soruyorum. İlginç geldi.

 

[1mak1mak]

Ama kontrol ettim Saaat Dakika bilgisi de gelmiyor. Sizce sebebi ne olabilir. Niye Sürekli uyarı veriyor olabilir.
Bence bu uyarıyı ne sebeple veriyorsa Makroyla veriyi alırken bu sebeple yeniden değişiklikleri kaydediyor.
İlginç geldi. Çok önemli değil ama taktım.

 

[Korhan Ayhan]

Merhaba,

Şimdi test amaçlı iki dosya hazırladım. Birisinin içine bir hücreye =BUGÜN() yazdım.

Paylaştığım kodu test ettim. İki dosyanında değişiklik tarihinde bende bir değişiklik olmadı.

Ek olarak sizde bir fark yaratırmı bilemiyorum ama aşağıdaki kodu deneyebilirsiniz.

Sub Ado_Kapali()
    Dim Con As Object, Rs As Object, Sorgu As String
   
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
   
    Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\Gürmen Yatırım.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select * From [Sayfa1$M2:M2]"
    Set Rs = Con.Execute(Sorgu)
    Range("A2").CopyFromRecordset Rs
    Rs.Close
    Con.Close
   
    Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\Gürmen Hesap.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select * From [Sayfa1$F5:F5]"
    Set Rs = Con.Execute(Sorgu)
    Range("A3").CopyFromRecordset Rs
    Rs.Close
   
    Sorgu = "Select * From [Sayfa1$G15:G15]"
    Set Rs = Con.Execute(Sorgu)
    Range("B4").CopyFromRecordset Rs
    Rs.Close

    Sorgu = "Select * From [Sayfa1$AB3:AB3]"
    Set Rs = Con.Execute(Sorgu)
    Range("B6").CopyFromRecordset Rs
    Rs.Close

    Con.Close
   
    Sorgu = vbNullString
    Set Rs = Nothing
    Set Con = Nothing
End Sub

 

[Korhan Ayhan]

Bu da farklı bir yöntem;

Option Explicit

Sub Import_Data_From_Closed_File()
    Dim File_Path As String, File_1 As String, File_2 As String
    
    File_Path = ThisWorkbook.Path & "\"
    File_1 = "[Gürmen Yatırım.xlsx]Sayfa1'!"
    File_2 = "[Gürmen Hesap.xls]Sayfa1'!"
    
    With Range("A2")
        .Formula = "=INDEX('" & File_Path & File_1 & "M2,1,1)"
        .Value = .Value
    End With
    
    With Range("A3")
        .Formula = "=INDEX('" & File_Path & File_2 & "F5,1,1)"
        .Value = .Value
    End With

    With Range("B4")
        .Formula = "=INDEX('" & File_Path & File_2 & "G15,1,1)"
        .Value = .Value
    End With

    With Range("B6")
        .Formula = "=INDEX('" & File_Path & File_2 & "AB3,1,1)"
        .Value = .Value
    End With
    
    MsgBox "Your transaction is complete."
End Sub

 

[1mak1mak]

Bu da farklı bir yöntem;

Option Explicit

Sub Import_Data_From_Closed_File()
    Dim File_Path As String, File_1 As String, File_2 As String
   
    File_Path = ThisWorkbook.Path & "\"
    File_1 = "[Gürmen Yatırım.xlsx]Sayfa1'!"
    File_2 = "[Gürmen Hesap.xls]Sayfa1'!"
   
    With Range("A2")
        .Formula = "=INDEX('" & File_Path & File_1 & "M2,1,1)"
        .Value = .Value
    End With
   
    With Range("A3")
        .Formula = "=INDEX('" & File_Path & File_2 & "F5,1,1)"
        .Value = .Value
    End With

    With Range("B4")
        .Formula = "=INDEX('" & File_Path & File_2 & "G15,1,1)"
        .Value = .Value
    End With

    With Range("B6")
        .Formula = "=INDEX('" & File_Path & File_2 & "AB3,1,1)"
        .Value = .Value
    End With
   
    MsgBox "Your transaction is complete."
End Sub

Hocam Merhaba
36.Nolu Mesajdaki Kod da yaptığınız değişikliği uyguladım gene aynı bir değişiklik olmadı Tarih Saaat değiştirdi.
37.Mesajdaki Kodu düzenleyip girdim o oldu Tarih Saat bilgisi değişmedi yani Kapalı dosya bilgisinde bir değişiklik yapmadı .
Kısaca 37.Mesajdaki Kod Tam istediğim gibi çalıştı. Teşekkür ederim ellerinize aklınıza sağlık.
Peki Size Sormak isterim bu XLSX olan Kapalı dosyaya bakmak için her girdiğimde çıkarken niye her defasında kayıt etmeyi sorar
Formül haricinde hiçbir şey olmamasına rağmen. Gerekirse Dosyayı Paylaşabilirim.
iyi çalışmalar.

 

[Korhan Ayhan]

BUGÜN fonksiyonu oynak (volatile) olarak tabir edilen bir fonksiyondur. Siz dosyayı açtığınızda fonksiyon kendisini revize eder. Excelde bunu değişiklik gibi algladığı için dosyayı kapatırken kaydetme sorusunu sorar.

 

[Korhan Ayhan]

Daha önceki mesajlarınızdan birinde xls uzantılı olan dosyanın değiştirme tarihinde bir değişiklik olmadığını belirtmiştiniz. İçinde BUGÜN formülü olan dosyanızı da xls uzantılı olarak kaydedip önceki önerdiğim kodları deneyerek sonucu bildirir misiniz?