Kapalı Dosyalardan koşullu olarak veri alma

[selcuk_c]

Merhaba,

Ekli dosyalarda açıklama metinleri ile anlatmaya çalıştım. Ekli dosyada genel.xls adlı bir dosyam var ve ayrıca aynı dizinde her gün tarihe göre ismi değişen (yeni eklediğim) isimleri tgk200909091, tgk200909092, tgk200909081, tgk200909082 gibi aynı günde sonunda 1-2 diye ayrılan her güne 2 dosya ekliyorum. bu dosyaların içinde A Sütununda TIRE, IST , XU100 adlı 3 satır var. bu satıların yanında yer alan değerleri Örneğin TIRE Satırında bulunan değerleri genel.xls de bulunan TIRE sayfasına ve XU100 olan satırıda yine genel.xls de bulunan XU100 alanın altına eklemek istiyorum. Aynı şekilde genel.xls deki IST sayfasınada diğer dosyalardaki IST satırının yanınadaki değerleri eklemek istiyorum. Yardımcı olabilecek arkadaşlara şimdiden çok teşekkürler,

İyi günler

 

[selcuk_c]

Yardımlarınızı bekliyorum Teşekkürler,

 

[Orion1]

Dosyanız ektedir.

Sub aktar()
Dim i As Long, dosya As String, yol As String, sat As Long, ds As String
Sheets("IST").Select
Application.ScreenUpdating = False
Range("A3:H65536").ClearContents
yol = ThisWorkbook.Path
dosya = Dir(yol & "\*.xls")
sat = 3
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        ds = Left(dosya, Len(dosya) - 5)
        ds = Right(ds, Len(ds) - 3)
        ds = Right(ds, 2) & Left(ds, Len(ds) - 2)
        ds = Left(ds, 2) & "." & Right(ds, 2) & "." & Left(ds, Len(ds) - 2)
        ds = Left(ds, 6) & Right(ds, 4)
        Cells(sat, "A").Value = CDate(ds)
        Cells(sat, "B").Value = Mid(dosya, 12, 1)
        Cells(sat, "C").Value = Application.ExecuteExcel4Macro("'" & yol & "\[" & dosya & "]1'!R2C2")
        Cells(sat, "E").Value = Application.ExecuteExcel4Macro("'" & yol & "\[" & dosya & "]1'!R2C4")
        Cells(sat, "F").Value = Application.ExecuteExcel4Macro("'" & yol & "\[" & dosya & "]1'!R3C2")
        Cells(sat, "H").Value = Application.ExecuteExcel4Macro("'" & yol & "\[" & dosya & "]1'!R3C4")
        sat = sat + 1
    End If
    dosya = Dir
Loop
Range("A3:H65536").Sort key1:=Range("A3"), key2:=Range("B3")
Application.ScreenUpdating = True
MsgBox "Akatarım tamalandı.", vbOKOnly + vbInformation, "AKTARIM"
End Sub

 

[selcuk_c]

Cells(sat, "A").Value = CDate(ds)

bu satırda type mismatch hatası veriyor. Nasıl düzeltebilirim?

 

[Orion1]

Cells(sat, "A").Value = CDate(ds)

bu satırda type mismatch hatası veriyor. Nasıl düzeltebilirim?

Bu dosyaların olduğu klasörün içinde sizin çalıştırdığınız asıl dosyanın olması lazım.
Ayrıyetten dosyalar bana anlattığınız format dışında olmaması lazım.soldan işte ne biletyim 3 karakteri bilmem ne solda 3 karalkteri bimme ne geri kalan tarih değeri olmalı.Tabii atıyorum bunları.Sizin dosyanız bana yoladığınızda ayni formatta olmalı.Bakın dosyayı ve dier veri dosyalarını yollayım.Burada sorun yok ben denedim çalışıyor.
Aşağıda ki dosyaları klasörün içinde çalıştırın balkalım hata verecekmi.
Hata svermiyorsa demekki farklı formatta dosyalar var klasörün içersinde
dosyalar ekte.

 

[selcuk_c]

dosyaları bulmakta sorun olmuyordu. Sadece cdate komutu sildim direk ds değişkenini at dedim sorun çözüldü. nedenini anlamadım ama çok teşekkür ederim. Sayenizde bişeyler öğrendim.

 

[Orion1]

dosyaları bulmakta sorun olmuyordu. Sadece cdate komutu sildim direk ds değişkenini at dedim sorun çözüldü. nedenini anlamadım ama çok teşekkür ederim. Sayenizde bişeyler öğrendim.

Olur ama o zamanda o hücreye veri tarih biçiminde atılmaz.Bu sakıncası var ve atılan tarihlere dikkat edin.Hatalı değerler mutlaka vardır.Tarih yerine en az bir karakteri değişik bir değer olan veriler vardır ilgili sütunda.
Demkki sizin dosyalarınızın hepsi bana gönderdiğiniz biçimde değil.Bu durumda o satırın hata vermesi normaldir.