Kapalı Excel dosyasından belirli bir sayfadaki verileri kopy

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Kapalı Excel dosyasından belirli bir sayfadaki verileri kopy

İleti#1)  hilmitaranci » 14 Ekm 2018 23:43

Merhabalar,

KKD_izmir
KKD_ankara
KKD_istanbul
KKD_tum
olmak üzere aynı klasör içinde 4 adet excel dosyam bulunmakta.

Tüm dosyalardaki sayfa isimleri birebir aynı.

izmir, istanbul ve ankara dosyasındaki sayfa1 ve sayfa3 leri button aracıyla, KKD_tum dosyamın içindeki sayfa1ve sayfa3 e alt alta kopyalamaya çalışıyorum.

İnternette bir kaç tane örnek buldum ancak onlarda hücre bazında kopyalama yaptığı için sonuca ulaşamadım.

Dosyalar çok ve büyük olduğu için örnek koyamadım. Eğer gerekli ise dataları temizleyip ekleyebilirim.

Teşekkür ederim.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#2)  tasad » 15 Ekm 2018 19:18

Örnek dosya ekleyin,yardımcı oluruz.
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#3)  hilmitaranci » 15 Ekm 2018 22:31

tasad yazdı:Örnek dosya ekleyin,yardımcı oluruz.


Merhabalar,

Örnek dosyaları ekte gönderdim.

Yardımlarınız için şimdiden çok teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#4)  tasad » 15 Ekm 2018 23:43

Dosyayı ekledim,deneyin...
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#5)  hilmitaranci » 16 Ekm 2018 00:11

tasad yazdı:Dosyayı ekledim,deneyin...


Ustam ellerinize sağlık.
Çok güzel olmuş. Teşekkür ederim.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#6)  hilmitaranci » 17 Ekm 2018 18:27

tasad yazdı:Dosyayı ekledim,deneyin...


Tekrardan rahatsızlık veriyorum hocam kusura bakmayın.

Yazmış olduğunuz kodu kendi dosyama uyarladım, sadece metin içeren hücrelerin kopyalanmasında problem yapıyor. Rakam içeren satır/sütun/hücreleri aktarıyor. Ancak sadece metin olanları aktarmıyor.

Problem neyden kaynaklanıyor olabilir?
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#7)  tasad » 17 Ekm 2018 19:03

Orjinal dosyanızdan bir kısımını örnek olarak ekleyebilir misin?
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#8)  hilmitaranci » 18 Ekm 2018 10:24

tasad yazdı:Orjinal dosyanızdan bir kısımını örnek olarak ekleyebilir misin?


Dosyanın orjinalini (orjinal hali yaklaşık 15 MB) bozmaya çalıştığımda çalışmadığı için ekran görüntüsü ve ilgili kodu atıyorum.



Kullandığım kod;

Private Sub CommandButton5_Click()

Dim con As Object, rs As Object, Fso As Object, Klasor As Object, Dosyalar As Object
Dim Sorgu As String, Dosya As String

Set con = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.RecordSet")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.getfolder(ThisWorkbook.Path)

Sayfa4.Range("A2:Z65000").Clear
For Each D In Klasor.Files
If D.Name < "\\192.168.128.28\mopak\İş_Kıyafetleri\PERSONEL GİYİM VE KKD.xls" Then
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Or VBA.Right(D.Name, 3) = "xls" Then
con.Open "provider=Microsoft.Ace.OleDb.12.0;Data Source=" & D.Path & _
";Extended Properties=""Excel 12.0;HDR=yes"""
Sorgu = "Select * FROM [stok$]"
'Sorgu = "Select * from [stok$A2:O60000]"
rs.Open Sorgu, con, 1, 1
satir = Sayfa4.Range("A65535").End(xlUp).Row + 1
'Sayfa1.Range("a" & Cells(Rows.Count, "a").End(3).Row + 1).CopyFromRecordset rs
Sayfa4.Range("A" & satir).CopyFromRecordset rs
rs.Close
con.Close
End If
End If
Next D
Set con = Nothing: Set rs = Nothing: Set Fso = Nothing: Set Klasor = Nothing
Set Dosyalar = Nothing: Dosya = vbNullString

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#9)  tasad » 18 Ekm 2018 11:11

Aşağıdaki kodları kaydedin.Dosyayı kapatıp yeniden açın.
Kod: Tümünü seç
Private Sub CommandButton2_Click()
Dim con As Object, rs As Object, Fso As Object, Klasor As Object, Dosyalar As Object
Dim Sorgu As String, Dosya As String
Set con = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.RecordSet")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.getfolder(ThisWorkbook.Path)
Sayfa1.Range("a2:j100000").Clear
For Each D In Klasor.Files
If D.Name < "\\192.168.128.28\mopak\İş_Kıyafetleri\PERSONEL GİYİM VE KKD.xlsm" Then
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Or VBA.Right(D.Name, 3) = "xls" Then
con.Open "provider=Microsoft.Ace.OleDb.12.0;Data Source=" & D.Path & _
";Extended Properties=""Excel 12.0;HDR=yes"""
Sorgu = "Select * FROM [stok$]"
rs.Open Sorgu, con, 1, 1
Sheets("stok").Range("a" & Cells(Rows.Count, "a").End(3).Row + 1).CopyFromRecordset rs
rs.Close
con.Close
End If
End If
Next D
Set con = Nothing: Set rs = Nothing: Set Fso = Nothing: Set Klasor = Nothing
Set Dosyalar = Nothing: Dosya = vbNullString
End Sub
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#10)  hilmitaranci » 18 Ekm 2018 18:20

tasad yazdı:Aşağıdaki kodları kaydedin.Dosyayı kapatıp yeniden açın.
Kod: Tümünü seç
Private Sub CommandButton2_Click()
Dim con As Object, rs As Object, Fso As Object, Klasor As Object, Dosyalar As Object
Dim Sorgu As String, Dosya As String
Set con = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.RecordSet")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.getfolder(ThisWorkbook.Path)
Sayfa1.Range("a2:j100000").Clear
For Each D In Klasor.Files
If D.Name < "\\192.168.128.28\mopak\İş_Kıyafetleri\PERSONEL GİYİM VE KKD.xlsm" Then
If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Or VBA.Right(D.Name, 3) = "xls" Then
con.Open "provider=Microsoft.Ace.OleDb.12.0;Data Source=" & D.Path & _
";Extended Properties=""Excel 12.0;HDR=yes"""
Sorgu = "Select * FROM [stok$]"
rs.Open Sorgu, con, 1, 1
Sheets("stok").Range("a" & Cells(Rows.Count, "a").End(3).Row + 1).CopyFromRecordset rs
rs.Close
con.Close
End If
End If
Next D
Set con = Nothing: Set rs = Nothing: Set Fso = Nothing: Set Klasor = Nothing
Set Dosyalar = Nothing: Dosya = vbNullString
End Sub



Ustam dediklerinizi aynen yaptım ancak ne hikmetse, metin içeren B sütunundaki verileri getirmiyor. Elle eklemeye başladım bende ama her çalıştırdığımda silindiği için baya zorlamaya başladı.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#11)  tasad » 18 Ekm 2018 18:34

Garip bir olay...
Dediğim gibi , orjinal dosyalardan örnek ekleyebilirseniz , belki bir çözüm buluruz.
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#12)  hilmitaranci » 18 Ekm 2018 19:05

tasad yazdı:Garip bir olay...
Dediğim gibi , orjinal dosyalardan örnek ekleyebilirseniz , belki bir çözüm buluruz.



Ustam tüm dosyları temizleyerek ekledim.
İnşallah düzelebilir.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#13)  tasad » 19 Ekm 2018 11:31

Aşağıdaki kodları deneyin.
Yine olmaz ise , veri aldığınız dosyalardaki B sütunu tamamını seçip metin olarak kayıt etmelisiniz.
Kod: Tümünü seç
Private Sub CommandButton5_Click()
Dim con As Object, rs As Object, Fso As Object, Klasor As Object, Dosyalar As Object
Dim Sorgu As String, Dosya As String
Sheets("stok").Range("a2:z65000").Clear
Set con = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.RecordSet")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.getfolder(ThisWorkbook.Path)
For Each D In Klasor.Files

      If D.Name <> "PERSONEL GİYİM VE KKD.xls" Then
        If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Or VBA.Right(D.Name, 3) = "xls" Then
        con.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & D.Path & _
        ";Extended Properties=""Excel 12.0;no=IMEX=1"";"
        Sorgu = "Select  *from [stok$]"
        rs.Open Sorgu, con, 1, 1
        Sheets("stok").Range("a" & Cells(Rows.Count, "a").End(3).Row + 1).CopyFromRecordset rs
       
        rs.Close
        con.Close
    End If
End If
Next D
Set con = Nothing: Set rs = Nothing: Set Fso = Nothing: Set Klasor = Nothing
Set Dosyalar = Nothing: Dosya = vbNullString
End Sub
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#14)  hilmitaranci » 23 Ekm 2018 00:17

tasad yazdı:Aşağıdaki kodları deneyin.
Yine olmaz ise , veri aldığınız dosyalardaki B sütunu tamamını seçip metin olarak kayıt etmelisiniz.
Kod: Tümünü seç
Private Sub CommandButton5_Click()
Dim con As Object, rs As Object, Fso As Object, Klasor As Object, Dosyalar As Object
Dim Sorgu As String, Dosya As String
Sheets("stok").Range("a2:z65000").Clear
Set con = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.RecordSet")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.getfolder(ThisWorkbook.Path)
For Each D In Klasor.Files

      If D.Name <> "PERSONEL GİYİM VE KKD.xls" Then
        If VBA.Right(D.Name, 4) = "xlsx" Or VBA.Right(D.Name, 4) = "xlsm" Or VBA.Right(D.Name, 3) = "xls" Then
        con.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & D.Path & _
        ";Extended Properties=""Excel 12.0;no=IMEX=1"";"
        Sorgu = "Select  *from [stok$]"
        rs.Open Sorgu, con, 1, 1
        Sheets("stok").Range("a" & Cells(Rows.Count, "a").End(3).Row + 1).CopyFromRecordset rs
       
        rs.Close
        con.Close
    End If
End If
Next D
Set con = Nothing: Set rs = Nothing: Set Fso = Nothing: Set Klasor = Nothing
Set Dosyalar = Nothing: Dosya = vbNullString
End Sub



Hocam dediğin gibi ancak yapabildim. Öteki türlü ne denediysem maalesef olmadı.
En azından tüm verileri alabiliyorum.
Ancak bazı sütunlarda (özellikle tarih) format hatası alıyorum.
Bunu nasıl düzelte bilirim?
Teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#15)  tasad » 23 Ekm 2018 12:11

Örnek bir dosya ekleyin,düzeltmeye çalışırız.
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta

Cevap: Cevap: Kapalı Excel dosyasından belirli bir sayfadaki

İleti#16)  hilmitaranci » 23 Ekm 2018 13:09

tasad yazdı:Örnek bir dosya ekleyin,düzeltmeye çalışırız.


Dosyayı ekledim.
Yardımlarınız için teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hilmitaranci
Yeni Başlamış
 
Kayıt: 07 Eyl 2015 16:43
Meslek: Özlük İşleri Şefi
Yaş: 38
İleti: 14
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

Cevap: Kapalı Excel dosyasından belirli bir sayfadaki verile

İleti#17)  tasad » 23 Ekm 2018 18:22

Dosyayı ekledim , inceleyin.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
tasad
Siteye Alışmış
 
Kayıt: 04 Şub 2018 11:46
Meslek: muhasebeci
Yaş: 26
İleti: 288
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ısparta


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Yandex[Bot] ve 2 misafir

cron
Bumerang - Yazarkafe