başka bir excel belgesinden makro ile veri almak

[imyourfate]

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

 

[imyourfate]

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

 

[asi_kral]

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.

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

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.

 

[imyourfate]

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

Hayırlı akşamlar

 

[asi_kral]

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

Hayırlı akşamlar

Kolay Gelsin.

 

[mkaraaslan]

teşekkürler..