• DİKKAT

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

başka bir excel belgesinden makro ile veri almak

Katılım
24 Mart 2011
Mesajlar
139
Excel Vers. ve Dili
excel 2007 türkçe
Değerli hocalarım iyi akşamlar

araştırdım ama işimi görecek bir örnek bulamadım ihtiyacım kısaca herhangi bir kapalı belgeden veri almak için yazılmış örnek bir makro şöyle ki ''x'' isimli belgenin sayfa1 den A1;Q300 veriyi al ''y'' belgesi sayfa1 de A1;Q300 ' e yapıştır bukadar herhanki bir örnek yada bir fikir verebilirseniz


Saygılarımla
 
Değerli hocalarım iyi akşamlar

araştırdım ama işimi görecek bir örnek bulamadım ihtiyacım kısaca herhangi bir kapalı belgeden veri almak için yazılmış örnek bir makro şöyle ki ''x'' isimli belgenin sayfa1 den A1;Q300 veriyi al ''y'' belgesi sayfa1 de A1;Q300 ' e yapıştır bukadar herhanki bir örnek yada bir fikir verebilirseniz


Saygılarımla
 
Değerli hocalarım iyi akşamlar

araştırdım ama işimi görecek bir örnek bulamadım ihtiyacım kısaca herhangi bir kapalı belgeden veri almak için yazılmış örnek bir makro şöyle ki ''x'' isimli belgenin sayfa1 den A1;Q300 veriyi al ''y'' belgesi sayfa1 de A1;Q300 ' e yapıştır bukadar herhanki bir örnek yada bir fikir verebilirseniz


Saygılarımla

Merhaba
Y kitabında boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub veri_çek_1967()
'Konu       :   Kapalı Dosyadan Veri Çek
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim KTP As Workbook, ASİ As Excel.Application
Dim A1S1 As Worksheet, A2S2 As Worksheet
Dim A1 As String, A2 As String, YOL As String
Dim HCR As Variant
Application.ScreenUpdating = False
Set ASİ = CreateObject("Excel.Application")
ASİ.Visible = False
YOL = ThisWorkbook.Path & "\"
A1 = ActiveWorkbook.Name
Set A1S1 = Workbooks(A1).Sheets("Sayfa1")
A2 = "x.xlsm"
HCR = ActiveCell.Address
Set KTP = ASİ.Workbooks.Open(YOL & A2)
Set A2S2 = KTP.Sheets("Sayfa1")
A2S2.Range("A1:Q300").Copy
A1S1.Range("A1").PasteSpecial (xlPasteValues)
KTP.Save: ASİ.Quit
Range(HCR).Select
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Otomatik olmasını istiyorsanız
Kod:
Option Explicit
Sub veri_çek_1967()
'Konu       :   Kapalı Dosyadan Veri Çek
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim KTP As Workbook, ASİ As Excel.Application
Dim A1S1 As Worksheet, A2S2 As Worksheet
Dim A1 As String, A2 As String, YOL As String
Dim HCR As Variant
Application.ScreenUpdating = False
Set ASİ = CreateObject("Excel.Application")
ASİ.Visible = False
YOL = ThisWorkbook.Path & "\"
A1 = ActiveWorkbook.Name
Set A1S1 = Workbooks(A1).Sheets("Sayfa1")
A2 = "x.xlsm"
HCR = ActiveCell.Address
Set KTP = ASİ.Workbooks.Open(YOL & A2)
Set A2S2 = KTP.Sheets("Sayfa1")
A2S2.Range("A1:Q300").Copy
A1S1.Range("A1").PasteSpecial (xlPasteValues)
KTP.Save: ASİ.Quit
Range(HCR).Select
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Sub auto_open()
veri_çek_1967
End Sub
Bu kodu kopyalayın ve deneyin.
Yol bilgisini siz ayarlarsınız.
Dosyalar Ekte.
 

Ekli dosyalar

Allah razı olsun mükemmel bir çalışma olmuş :)

Hayırlı akşamlar
 
teşekkürler..
 
Geri
Üst