Kapalı-Açık dosyadaki verileri başka dosyada toplama

[mkarakas_58]

Arkadaşlar, lütfen yardım edin...

Şimdi ekdeki rarda, dosyalar klasörün içinde 8 adet excel dosyası var. Bu dosyaların her birinden B2:K202 hücreleri arasındaki verileri alıp, talepler dosyasındaki sayfaya eklemesini istiyorum.

O 8 dosyadaki veriler değişken olacağindan, ben her talepler dosyasını açtığımda; dosyalar klasöründeki 8 exceldeki verilerin en güncelini almasını istiyorum...

Bilmem anlatabildim mi derdi mi?

Özel tablo ekleden beceremedim daha doğrusu bir dosyadan veri alabiliyorum ama ben 8 excel dosyasından verileri almam gerekli....

İlgilenen arkadaşlara şimdiden teşekkürler...

 

[muygun]

Merhaba;
Veri alınacak grup dosyaları ile talepler dosyasını aynı klasörde bulundurun.


Not: Özelliklerinizdeki şehir ismini düzeltirseniz güzel Türkçe'miz yara almamış olur.

İyi çalışmalar.

 

[Orion1]

Dosyanız ektedir.

Sub aktar59()
Dim sat1 As Long, i As Long, sut As Byte, yol As String
Dim dosya As String, sat2 As Long, sh As Worksheet
Application.ScreenUpdating = False
sat1 = 3
yol = ThisWorkbook.Path & "\DOSYALAR\"
With Sheets("TOPLU")
    .Range("B3:K" & Rows.Count).ClearContents
    dosya = Dir(yol & "*.xls")
    Do While dosya <> ""
        If Workbooks.Open(yol & dosya).ReadOnly = True Then Workbooks(dosya).Close False
            Set sh = ActiveWorkbook.Sheets("TALEPLER")
            sat2 = sh.Cells(Rows.Count, "C").End(xlUp).Row
            If sat2 > 2 Then
                sh.Range("B3:K" & sat2).Copy
                .Range("B" & sat1).PasteSpecial
                Application.CutCopyMode = False
                Set sh = Nothing
            End If
        dosya = Dir
        ActiveWorkbook.Close False
        sat1 = .Cells(Rows.Count, "C").End(xlUp).Row + 1
    Loop
End With
Application.ScreenUpdating = True
MsgBox "işlem tamamlandı." & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub