Kapalı excel hücre Kopyalama

[hlojan]

Merhaba;

Kapalı excelden range kopyalamak istiyorum

Başaramadım

Örnek Kodum

Dim kaynak As Workbook
ChDir ThisWorkbook

Dosya = Application.GetOpenFilename(FileFilter:="," & _
        "*.xls;*.xlsm;*.bmp;*.jpg;*.gif;*.pdf;*.mdb", _
        Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
    If Dosya = False Then ' eğer vazgeçe basarsanız
        MsgBox "Dosya seçme işleminden vazgeçildi"
        Exit Sub
    Else
        Set anawb = ThisWorkbook
      Set kaynak = Workbooks.Open(Dosya)
      kaynak.Visible = False
      kaynak.Sayfa1.Range("b2:h28").Copy
      anawb.Sayfa1.Range("f3").Paste
      kaynak.Close savechanges = False
 
    End If
    Exit Sub
hata:
    MsgBox "Klasör bulunamdı", vbCritical, "UYARI"

Örnek Dosyamda ektedir

İyi Çalışmalar

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodları kullanın.

Sub test()
    Dim Dosya As String
    Dim kaynak As Workbook
    Dim anawb As Workbook
    Dosya = Application.GetOpenFilename(FileFilter:="," & _
        "*.xls;*.xlsm;*.bmp;*.jpg;*.gif;*.pdf;*.mdb", _
        Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
    If Dosya = "False" Then ' eğer vazgeçe basarsanız
        MsgBox "Dosya seçme işleminden vazgeçildi"
        Exit Sub
    Else
        Set kaynak = Workbooks.Open(Dosya)
        Windows(1).Visible = False
        kaynak.Worksheets("ÖDEMELER").Range("b2:h28").Copy ThisWorkbook.Worksheets("Sayfa1").Range("f3")
        kaynak.Close savechanges:=False
    End If
    Exit Sub
hata:
    MsgBox "Klasör bulunamdı", vbCritical, "UYARI"

End Sub