Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: drejan62 - 19 Ağustos 2010, 11:09:20

Başlık: [Çözüldü] Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: drejan62 - 19 Ağustos 2010, 11:09:20

Merhabalar,
c:\Belgelerim\Maaşlar Klasörü içinde
Maaş1, Maaş2, Maaş3, Maaş4, Maaş5 isimli dosyalarımız var.
Bu dosyalarda veriler 7. satırdan başlıyor ve satır sayısı değişken,
Amacım kodları yazdığım Çalışma kitabında Sayfa1'e bu maaşları alt alta kaydetmek. Yanlız ilk maaşı1 sayfasını 7. satırdan en son satıra kadar alacak sonraki maaş2,3,5 çalışma kitaplarını ise 8, satırdan son satıra kadar alarak alt alta kaydedecek.
ben alttaki kodları deniyorum ama zaman alıyor haliyle,
zaman kazanmak için kodları kısaltabilirmiyiz,
Teşekkürler

Kod: [Seç]

 
Workbooks.Open Filename:="C:\\Belgelerim\Maaşlar \Maaş1.xls"
   
    Range("C7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("TümMaaş.xls").Activate
    Sheets("Sayfa1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.End(xlDown).Select
    Windows("Maaş1.xls").Activate
    ActiveWorkbook.Close False
   
Workbooks.Open Filename:="C:\\Belgelerim\Maaşlar \Maaş2.xls"

    Range("C8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("TümMaaş.xls").Activate
    Sheets("Sayfa1").Select
    ActiveCell.Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.End(xlDown).Select
    Windows("Maaş2.xls").Activate
    ActiveWorkbook.Close False 

Başlık: Ynt: Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: Orion1 - 19 Ağustos 2010, 13:25:20

Alıntı yapılan: drejan62 - 19 Ağustos 2010, 11:09:20

Merhabalar,
c:\Belgelerim\Maaşlar Klasörü içinde
Maaş1, Maaş2, Maaş3, Maaş4, Maaş5 isimli dosyalarımız var.
Bu dosyalarda veriler 7. satırdan başlıyor ve satır sayısı değişken,
Amacım kodları yazdığım Çalışma kitabında Sayfa1'e bu maaşları alt alta kaydetmek. Yanlız ilk maaşı1 sayfasını 7. satırdan en son satıra kadar alacak sonraki maaş2,3,5 çalışma kitaplarını ise 8, satırdan son satıra kadar alarak alt alta kaydedecek.
ben alttaki kodları deniyorum ama zaman alıyor haliyle,
zaman kazanmak için kodları kısaltabilirmiyiz,
Teşekkürler

Kod: [Seç]

 
Workbooks.Open Filename:="C:\\Belgelerim\Maaşlar \Maaş1.xls"
   
    Range("C7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("TümMaaş.xls").Activate
    Sheets("Sayfa1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.End(xlDown).Select
    Windows("Maaş1.xls").Activate
    ActiveWorkbook.Close False
   
Workbooks.Open Filename:="C:\\Belgelerim\Maaşlar \Maaş2.xls"

    Range("C8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("TümMaaş.xls").Activate
    Sheets("Sayfa1").Select
    ActiveCell.Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.End(xlDown).Select
    Windows("Maaş2.xls").Activate
    ActiveWorkbook.Close False

Örnek dosyaları eklerseniz bir şeyler yaparız.

Başlık: Ynt: Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: drejan62 - 19 Ağustos 2010, 15:27:46

Üstad,
Örnek dosya eklidim.
Teşekkür ederim.
Maaş1 ve Maaş2 dosyalırındaki veriler
Tümmaş dosyasındaki Sayfa1 e kopyalanacak.
sağolun

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: Orion1 - 19 Ağustos 2010, 18:53:12

Dosyanız ektedir. :cooll

Kod: [Seç]

Sub aktar_59()
Dim i  As Byte, conn As Object, rs As Object, sat As Long
Dim dosya As String
Sheets("Sayfa1").Select
sat = 2
Range("A2:M65536").ClearContents
Application.ScreenUpdating = False
Set conn = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.Recordset")
For i = 1 To 2
    dosya = "Maaş" & i & ".xls"
    If Dir(ThisWorkbook.Path & "\" & dosya) = "" Then
        MsgBox ThisWorkbook.Path & "\" & dosya & " Bulunamdı.", vbCritical, "UYARI"
        Else
        conn.Open "Provider=Microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\" & dosya & ";extended properties=""Excel 8.0;Hdr=no;imex=1"";"
        rs.Open "Select * from [Sayfa1$A8:M65536];", conn, 1, 1
        If rs.RecordCount > 0 Then
            Range("A" & sat).CopyFromRecordset rs
            sat = Cells(65536, "A").End(xlUp).Row + 1
        End If
        rs.Close: conn.Close
    End If
Next i
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
If Cells(65536, "A").End(xlUp).Row > 1 Then
    MsgBox "Veriler aktarıldı." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
End Sub
[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: drejan62 - 20 Ağustos 2010, 13:58:12

Teşekkürler üstad.
Çok sağol

Başlık: Ynt: Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: Orion1 - 20 Ağustos 2010, 21:02:40

Rica ederim.
İyi çalışmalar. :cooll

Başlık: Ynt: [Çözüldü] Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: assenucler - 14 Eylül 2010, 08:28:38

Sayın Evren Gizlen;

Günaydın..

Bu güzel katkınızı içeren dosyayı arşivliyorum. Teşekkürler...

Başlık: Ynt: [Çözüldü] Kapalı Excel Çalışma Kitaplarından Veri Çekmek
Gönderen: ihsantutkun54 - 09 Aralık 2019, 17:07:25

merhaba,

Ben belirttiğiniz metodu kullanarak verileri çektim. Bu sebepten dolayı çok teşekkürler. Ancak saatler "10:21:06 ÖÖ" veya "11:48:15 ÖS" şeklinde geliyor. Sayı biçiminden "23:48:15" yapmak istiyorum ancak değişmiyor. Yardımcı olabilirseniz çok sevinirim. Şimdiden teşekkürler