Farklı excel dosyalarından veri almak

[alicam]

Merhaba
Örneğin elimde 50 tane farklı isimde excel dosyaları var. Ben bu dosyaları açmadan tüm excel dosyalarındaki mesela H sütunundaki verileri bir sütuna kopyalamak istiyorum. Örneğin:
ali.xls
veli.xls
ahmet.xls
adında üç dosyam var. Bu üç dosyadaki H sütunundaki verileri
mehmet.xls dosyasında aynı sütuna çekmek istiyorum.
Ne yapmalıyım?
Desteğiniz için şimdiden teşekkür ederim.

 

[Orion1]

Merhaba
Örneğin elimde 50 tane farklı isimde excel dosyaları var. Ben bu dosyaları açmadan tüm excel dosyalarındaki mesela H sütunundaki verileri bir sütuna kopyalamak istiyorum. Örneğin:
ali.xls
veli.xls
ahmet.xls
adında üç dosyam var. Bu üç dosyadaki H sütunundaki verileri
mehmet.xls dosyasında aynı sütuna çekmek istiyorum.
Ne yapmalıyım?
Desteğiniz için şimdiden teşekkür ederim.

Sorunuzu örnek dosya/dosyalarla destekleyiniz.
Yanısıra dosya üzerindede elle bir kaç veri girin ki
olmuş halide gözüksün.

 

[asi_kral]

Merhaba
Örneğin elimde 50 tane farklı isimde excel dosyaları var. Ben bu dosyaları açmadan tüm excel dosyalarındaki mesela H sütunundaki verileri bir sütuna kopyalamak istiyorum. Örneğin:
ali.xls
veli.xls
ahmet.xls
adında üç dosyam var. Bu üç dosyadaki H sütunundaki verileri
mehmet.xls dosyasında aynı sütuna çekmek istiyorum.
Ne yapmalıyım?
Desteğiniz için şimdiden teşekkür ederim.

Merhaba
1. Hiç açılmayacak mı_? Yoksa arka planda otomatik açılsa ve kapansa problem olur mu_?
2. Bu dosyaların hepsi aynı klasörde mi_? Yoksa kaydedilecek dosya bir yerde diğer dosyalar başka bir yerde mi_?

 

[alicam]

Merhaba
Dosyaların tamamı kendi bilgisayarımda ve aynı klasörde. Dosyaların arka planda açılıyor olması da önemli değil. 100 den fazla excel dosyası var ve o dosyaların tamamındaki aynı sütundaki verler bana lazım.
Örnek dosyaları gönderdim.
tel1, tel2 ve tel3 dosyalarındaki B sütunundaki verilerin tümtelefonlar dosyasında b sütununa sıralanması gerekiyor.

Not: Eğer daha kolay olacaksa üç dosyadaki tüm verilerin tek bir dosyada alt alta sıralanması da işimi görebilir.

 

[Orion1]

Dosyanız ektedir.

Sub telefon_59()
'veriler ado ile alındı.
'referanslardan microsoft activeX dataobjects 2.8 library eklendi.
'Başka dosyada kullanacaksanız bu active x nesnesini eklemniz gerekir.
Dim sat1 As Long, sat2 As Long, dosya As String
Dim conn As ADODB.Connection, rs As ADODB.Recordset, dsy As String
Sheets("Sayfa1").Select
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Application.ScreenUpdating = False
Range("B2:B" & Rows.Count).ClearContents
dosya = Dir(ThisWorkbook.Path & "\*.xls")
sat1 = 2
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        dsy = ThisWorkbook.Path & "\" & dosya
        conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & dsy & ";extended properties=""excel 8.0;hdr=yes;imex=1""")
        rs.Open "select Telefon from[Sayfa1$B:B];", conn, adOpenKeyset, adLockReadOnly
        If rs.RecordCount > 0 Then
            Range("B" & sat1).CopyFromRecordset rs
            sat1 = Cells(Rows.Count, "B").End(xlUp).Row + 1
        End If
        rs.Close
        conn.Close
        End If
     dosya = Dir
Loop
Set rs = Nothing
Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Klasördeki excel dosyalarından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[alicam]

Dosyanız ektedir.

Teşekürler Orion1 Çok işime yaradı. Ellerine sağlık...