• DİKKAT

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

BAŞKA KİTAPTAN BAŞKA KİTABA VERİ ÇEKME VE OTOMATİK GÜNCELLEME!!!

Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
arkadaşlar makro ile başka sayfadan veriyi almak istiyorum yalnız veri güncellendikçe otomatik orası da değişecek

örnek

ocak xlsm. kitaptaki E4 HÜCRESİNİNİ GENEL MİZAN XLSX. kitabında D6 HÜCRESİNE
ocak xlsm. kitaptaki J4 HÜCRESİNİNİ GENEL MİZAN XLSX. kitabında E6 HÜCRESİNE

VERİLERİ ÇEKMEK İSTİYORUM YARDIMINIZ İÇİN TŞKLER.
 
Bahsettiğiniz iki hücre için dosyalar arası formülle bağlantı kurabilirsiniz.
 
Merhaba,
Ekteki dosyaları inceleyiniz. Her iki dosyada aynı klasörde olmak şartıyla makro çalışmaktadır. Dosyalar örnek programlarda Belgelerim klasöründedir. Başka klasörde çalışacaksa makrodaki aşağıdaki komut uygun şekilde değiştirilmelidir.

DosyaYolu = "C:\Users\Mustafa Iscen\Documents\"
 

Ekli dosyalar

Yukarıda bulunan çalışmayı kendime uyarlamaya çalıştım.
Aktarmada alt satıra sınır koyamadım.
"Alt satır; 25.satır" olarak alım ve aktarım ve kayıtta nasıl sınırlandırılır.




Kod:
Sub Kapalı_Kitaptan_Veri_Al()

Range("A1:H150").Select
    Selection.ClearContents
    Range("H5").Select

Sheets("GİRİŞ").Select
DosyaYolu = "C:\Users\User\Desktop\"
Dosyaadı = "veriler"
Yol = DosyaYolu & Dosyaadı

Workbooks.Open Filename:=DosyaYolu & Dosyaadı & ".xlsm"
Set Oku = Sheets("DATA")
Set Yaz = ThisWorkbook.Sheets("GİRİŞ")


Son_Satır = 6
Son_Satır = Sheets("DATA").Range("C600").End(xlUp).Row

For s = 6 To Son_Satır
    Yaz.Cells(s, ("C")) = Oku.Cells(s - 0, ("D"))
    Yaz.Cells(s, ("D")) = Oku.Cells(s - 0, ("E"))
    
Next

ActiveWorkbook.Close

End Sub
 
Sonunda Çalıştı.
 
Kod:
Sub Kapalı_Dosyadan_Veri_Al()

Range("A1:H150").Select
    Selection.ClearContents
    Range("H5").Select

Sheets("GİRİŞ").Select
DosyaYolu = "C:\Users\User\Desktop\"
Dosyaadı = "Geçen Yıl Satışlar 3"
Yol = DosyaYolu & Dosyaadı

Workbooks.Open Filename:=DosyaYolu & Dosyaadı & ".xlsm"
Set Oku = Sheets("SATIŞ")
Set Yaz = ThisWorkbook.Sheets("GİRİŞ")


ilk_Satır = 6
Son_Satır = 24

For s = 6 To Son_Satır
    Yaz.Cells(s, ("C")) = Oku.Cells(s - 0, ("D"))
    Yaz.Cells(s, ("D")) = Oku.Cells(s - 0, ("E"))
    
Next

ActiveWorkbook.Close

End Sub
 
Geri
Üst