Dosyayı Excele Aktarma

[1mak1mak]

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.

O halde yapacak birşey yok.
Bilgilendirme ve Yardımlarınız için çok Teşekkür ederim.

 

[Korhan Ayhan]

Burada önerdiğim yöntemi deneyip sonucu bildirir misiniz?

Dosyayı Excele Aktarma

Siz klasör mü seçmek istiyorsunuz yoksa tek bir dosya mı? Hocam tek bir excel dosyası xls. xlsm. v.s.

www.excel.web.tr

 

[1mak1mak]

Burada önerdiğim yöntemi deneyip sonucu bildirir misiniz?

Dosyayı Excele Aktarma

Siz klasör mü seçmek istiyorsunuz yoksa tek bir dosya mı? Hocam tek bir excel dosyası xls. xlsm. v.s.

www.excel.web.tr

Merhaba Korhan Hocam
Ben cevabı yazarken siz bir öneri yapmışsınız sayfa atlayınca görmemişim.
Daha önce XLSX dosyayı XLS olarak değiştirip denemiştim.
Ama tekrar şimdi denedim gene aynı hiçbir şey yapmadan açıp kaptsamda kaydetme uyarısı gene veriyor.
Kolay gelsin

 

[Korhan Ayhan]

#33 nolu mesajınızda ki durumu bahsettiğim şekilde deneyin demiştim. Dosyayı açıp kapatınca oynak formül olduğu için zaten kaydetme sorusu sorması normaldir. İlgili dosyanın uzantısını xls yapıp kodu denediğinizde yine dosyanın değiştirilme tarihi değişiyor mu bunu kontrol ediniz.

 

[1mak1mak]

#33 nolu mesajınızda ki durumu bahsettiğim şekilde deneyin demiştim. Dosyayı açıp kapatınca oynak formül olduğu için zaten kaydetme sorusu sorması normaldir. İlgili dosyanın uzantısını xls yapıp kodu denediğinizde yine dosyanın değiştirilme tarihi değişiyor mu bunu kontrol ediniz.

Şimdi anladım veri aldığım uyarı veren dosyanın xlsx uzantısını o kodla xls olarak veri aldım.
evet gene değiştirdi.
ama zaten bu problemi #37 mesajda ki kodla çözmüştük.

 

[Korhan Ayhan]

Bilgilendirme için teşekkür ederim.

 

[burhancavus61]

Korhan Hocam
Bende bir kod kullanıyorum işimi görüyor ama içerisinde değişiklik yapmaya çalıştım sürekli hata aldım.
İstediğim klasör ve dosya adı değişken sayfa adı sabit değişmiyor. Klasör aç ve seç yöntemi ile değiştirmek istiyorum.
Yardımcı olurmusunuz.

Sub Personel_Aktar()
    Dim filePath As String, sourceSheet As Worksheet, lastSourceRow As Long, Rng As Range
    MsgBox "Dosyanızı D: dizini altına Aktar isimi ile kaydedin aksi halde taşıma işlemi yapılamaz.", vbInformation

        Application.ScreenUpdating = True
        filePath = "D:\Aktar.xlsm"
        GetObject filePath
        Windows(Dir(filePath)).Visible = False
        Set sourceSheet = Workbooks(Dir(filePath)).Sheets("Personel")
        lastSourceRow = sourceSheet.Range("C" & Rows.Count).End(xlUp).Row
        Set Rng = sourceSheet.Range("C2:J" & lastSourceRow)
        Worksheets("Personel").Range("C2").Resize(Rng.Rows.Count, Rng.Columns.Count).Cells.Value = Rng.Cells.Value
        Workbooks(Dir(filePath)).Close SaveChanges:=False
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Merhaba Burhan Bey,

Neyi nereye aktarmak istediğinizi açıklarsanız yardımcı olabilirim.

 

[burhancavus61]

İki aynı kitap birisi eski diğeri yeni. Son güncellediğim kitabıma eski kitaptan veri çekmek istiyorum. Eski kitabın Personel sayfasından yeni kaitabın personel sayfasına C2:J2 dahil veriyi alıp yazmak amacım. Kitap başka klasörde başka adda olabilir. Dosya aç ile doyayı bulup seçerek veriyi çekmek amacım. Üstteki kod d nin altına sabit isimle aldığımda iş görüyor ama klasör ve isim değişince olmuyor. Çalışma kitabında değişiklikler yaptığımda çalışanlarla paylaşıyorum sadece eski veriyi çekmeleri yeterli oluyor amacım bu.

 

[Korhan Ayhan]

Deneyiniz.

Sub Personel_Aktar()
    Dim Dosya As Variant, Bağlanti As Object, Kayit_Seti As Object, Zaman As Double

    Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.xls;*.xlsx;*.xlsm),*xls;*.xlsm;*.xlsx", MultiSelect:=False)
    
    If Dosya = False Then
        MsgBox "Dosya seçimi yapmadığınız için işlem iptal edildi!", vbCritical
        Exit Sub
    End If
    
    Zaman = Timer
        
    Set Baglanti = CreateObject("Adodb.Connection")
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties = ""Excel 12.0 Macro;Hdr=No"""
        
    Range("C2:J" & Rows.Count).ClearContents
    
    On Error GoTo Hata
    
    Set Kayit_Seti = Baglanti.Execute("Select * From [Personel$C2:J] Where F3 Is Not Null")
    Range("C2").CopyFromRecordset Kayit_Seti
    
    Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Exit Sub

Hata:
    If Baglanti.State <> 0 Then Baglanti.Close
    
    Set Baglanti = Nothing
    
    MsgBox "Hatalı dosya seçtiniz!" & vbCrLf & vbCrLf & "Dosyada PERSONEL isimli sayfa bulunamadı!", vbCritical
End Sub

 

[burhancavus61]

Korhan hocam teşekkür ederim gayet güzel çalıştı. Emeğinize sağlık

 

[burhancavus61]

Korhan hocam sizin verdiğiniz kodlarla başka bir çalışma sayfasında uygulama yaptım oldu. Veri aldığım sayfaya kaydın kaldığı yerden ilave bir tablo daha eklemem gerekti kodda nasıl bi revizyon yapmam gerek. Personelin kaldığı hücreden sonrasına ilave örneğin C270 hücreden sonrasına bir bağlantı daha oluşturmam gerek. İkinci bağlantıyı ihtiyaç olduğunda kullanacağım.

Set Kayit_Seti = Baglanti.Execute("Select * From [Personel$C2:J] Where F3 Is Not Null")
Range("B2").CopyFromRecordset Kayit_Seti

Sanırım burda düzenleme yapmak gerek.

 

[burhancavus61]

Personel sayfasında sizin verdiğiniz koddan bir tane daha oluşturup bu sefer C sütununun son dolu hücresinden sonrasına eklemem gerek . İkinci bağlantıyı ihtiyaç olduğunda kullanacağım ama bu bağlantı aynı sayfanın son dolu hücresinden sonra başlaması gerek.

 

[Korhan Ayhan]

Bu kod satırını deneyiniz.

Cells(Rows.Count, 3).End(3) (2, 1).CopyFromRecordset Kayit_Seti

 

[burhancavus61]

Hocam kodu bu şekilde kullanınca eski veriyi siliyor üzerine yazıyor
son dolu hücreden sonrasına eklemek istiyorum siliyor yeniden ekliyor

Sub P_A()
    Dim Dosya As Variant, Bağlanti As Object, Kayit_Seti As Object, Zaman As Double
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.xls;*.xlsx;*.xlsm),*xls;*.xlsm;*.xlsx", MultiSelect:=False)
    
    Application.ScreenUpdating = False
    Range("C2").Select
    ActiveSheet.Unprotect
    
    If Dosya = False Then
    MsgBox "Dosya seçimi yapmadığınız için işlem iptal edildi!", vbCritical
        
    Exit Sub
    End If
    
    Zaman = Timer
    Set Baglanti = CreateObject("Adodb.Connection")
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties = ""Excel 12.0 Macro;Hdr=No"""
    Range("C2:J" & Rows.Count).ClearContents
    
    On Error GoTo Hata
    
    Set Kayit_Seti = Baglanti.Execute("Select * From [Personel$C2:J] Where F3 Is Not Null")
    Cells(Rows.Count, 3).End(3)(2, 1).CopyFromRecordset Kayit_Seti

    Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    
    Exit Sub

Hata:
    If Baglanti.State <> 0 Then Baglanti.Close
    Set Baglanti = Nothing
    
    MsgBox "Hatalı dosya seçtiniz!" & vbCrLf & vbCrLf & "Dosyada 'Personel' isimli sayfa bulunamadı!", vbCritical
End Sub

 

[Korhan Ayhan]

Alttaki satır olduğu için siliyor.

Range("C2:J" & Rows.Count).ClearContents

Bu satırı kaldırırsanız sorun düzelecektir.

 

[burhancavus61]

Tamam hocam teşekkür ederim şimdi çok iyi oldu.

 

[burhancavus61]

Hocam son verdiğiniz kodlarla başka sayfaya uyarladım sorun yok ama başka bir sorunum var. Sık kullanmadığım kapalı dosyanın bir sütunu hatalı veriyi çekmeden önece o sütunu düzeltip sonra çekme şansım varmı. Yani önce kapalı dosyaya veri yazmam lazım sonrada düzelmiş hali ile çekmem gerek. yada düzeltmeden çekerek açık dosyada ilgili sütunu nasıl düzeltirim. Bu kodlarda veriyi B sütunundan çekmeye başlıyorum hatalı sütun C sütunu ve C sütununun tüm satırlarının olması gereken değer 41. Kapalı ve açık dosya birebir aynı bilgilere sahip.

Yada şöyle olabilirmi hatalı sütunu almadan diğer bilgilere devam etsemde olur.
2. sütundan başlayacak 3. sütunu pas geçip diğer sütunlara devam edecek. Her türlü işimi görür. Yönlendirirseniz sevinirim. Veriyi çekmeden hatayı farkedemedim.

Sub MuhSgk_Aktar3_GSS()
    Dim Dosya As Variant, Bağlanti As Object, Kayit_Seti As Object, Zaman As Double
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.xls;*.xlsx;*.xlsm),*xls;*.xlsm;*.xlsx", MultiSelect:=False)
   
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
   
    If Dosya = False Then
    MsgBox "Dosya seçimi yapmadığınız için işlem iptal edildi!", vbCritical
       
    Exit Sub
    End If
   
    Zaman = Timer
    Set Baglanti = CreateObject("Adodb.Connection")
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties = ""Excel 12.0 Macro;Hdr=No"""
   
    On Error GoTo Hata
   
    Set Kayit_Seti = Baglanti.Execute("Select * From [maasEBildirgeExcel$B2:Y] Where F3 Is Not Null")
    Cells(Rows.Count, 2).End(3)(2, 1).CopyFromRecordset Kayit_Seti

    Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    Set Baglanti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation

Exit Sub

Hata:
    If Baglanti.State <> 0 Then Baglanti.Close
    Set Baglanti = Nothing
   
    MsgBox "Hatalı dosya seçtiniz!" & vbCrLf & vbCrLf & "Dosyada 'maasEBildirgeExcel' isimli sayfa bulunamadı!", vbCritical
End Sub

 

[burhancavus61]

mesajın kod bölümünü farketmedim çift yazmışım kusura bakmayın kod alanındakini kullanıyorum

 

[Korhan Ayhan]

Eğer aktarım işleminde C sütunu olmasın derseniz iki sorgu kullanmak gerekir.

Önce B sütununu aktarırsınız. Akabinde D ve kalan sütunları aktarabilirsiniz. Böylece aktarım işleminden C sütunu etkilenmemiş olur.

Ya da komple aktarıp C sütununu istediğiniz gibi düzenlersiniz.