• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Başka dosyalardan veri almak.!!!

Katılım
16 Kasım 2017
Mesajlar
255
Excel Vers. ve Dili
office professional plus 2021
Değerli Hocalarım merhabalar, herkese iyi çalışmalar. Bir makro konusunda yardımlarınızı rica edebilirmiyim. Formda bir hocam sağolsun aşağıda eklemiş olduğum kodları bana yazdı. Bu kodlarla sayfa1 de K1 ve K2 hücresindeki tarih aralığına uygun olan verileri sayfa2,sayfa3 ve sayfa4 den alıp sayfa1 e B3 İLE G3 arasına getiriyor. Benim arzu ettiğim şeyse aynı kodları diğer çalışma kitabımda farklı dosyalardan getirmesi. Yani musteri takip adında dosyam var. burda sayfa1 de M1 ve M2 hücrelerinde başlangıç bitiş tarihleri var.Makro yine bu tarihlere uyacak şekilde müşteriler klosörüne gidip orda kaç tane dosya varsa her dosyada kaç tane sayfa varsa hepsinin G4:G23(burda tarihler var) ve O4:O23 arasındaki verileri alıp musteri takip dosyasındaki sayfa1 deki A2:I2 arasına getirip aşağı doğru sıralaması. Sonuç olarak başka kapalı dosyalardan tarihe uygun olarak veriler getirmesini istiyorum. Yardımlarınız çok makbule geçecektir. Şimdiden teşekkürler.

Sub tarih_arasi_aktar()
Dim sh(), Syf As Worksheet, S1 As Worksheet
Dim Tarih_1 As Date, Tarih_2 As Date
Set S1 = Sheets("Sayfa1")
Tarih_1 = [K1]
Tarih_2 = [K2]
sh = Array("Sayfa2", "Sayfa3", "Sayfa4")
For Each Syf In Sheets(sh)
son = Syf.Cells(Rows.Count, 1).End(3).Row
a = Syf.Range("A3:G" & son).Value
For i = 1 To UBound(a)
If a(i, 1) >= Tarih_1 And a(i, 1) <= Tarih_2 Then
sayi = sayi + 1
End If
Next i
Next Syf
S1.Range("A3:G" & Rows.Count).ClearContents
If sayi > 0 Then
ReDim b(1 To sayi, 1 To UBound(a, 2))
For Each Syf In Sheets(sh)
son = Syf.Cells(Rows.Count, 1).End(3).Row
a = Syf.Range("A3:G" & son).Value
For i = 1 To UBound(a)
If a(i, 1) >= Tarih_1 And a(i, 1) <= Tarih_2 Then
say = say + 1
For y = 1 To UBound(a, 2)
b(say, y) = a(i, y)
Next y
End If
Next i
Next Syf
S1.[A3].Resize(say, UBound(a, 2)) = b
MsgBox "İşlem tamam.", vbInformation
Else
MsgBox "İşlem yok!!!!!", vbCritical
End If
End Sub
 
Son düzenleme:
Geri
Üst