Kapalı Dosyadan Veri Alma

[s.savas]

Merhaba arkadaşlar.
Aşağıdaki kod ile kapalı bir dosyadan veri alınırken, veri alınacak sayfanın tamamı kopyalanıyor. Kodda yapılacak değişiklikle istedimiz satır ve sütundan veri alınması için düzenleme yapabilirmiyiz.
Örnek: Listbox'ta listelenen sayfalardan her hangi birinin B6:C aralığındaki dolu hücreleri alabilirmiyiz.

Sub veri_al()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name

a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)

If a = False Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If

Kaynak = Mid(a, 1, Len(a) - Len(Dir(a)) - 1)
deg = "'" & Kaynak & "\" & "[" & Dir(a) & "]" & "x" & "'!R"

Cells(1, 1).Value = "=" & deg & 1 & "C" & 1
Cells(1, 1).Replace What:="=", Replacement:=""

alan1 = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
For k = 1 To Len(alan1)
If Mid(alan1, k, 1) = "]" Then
yer = (Len(alan1) - 6 - k)
sayfaadı = Mid(alan1, k + 1, yer)
End If
Next

Cells(1, 1).Value = sayfaadı

Dim Dosya
Dim wb As Workbook
Dosya = Dir(a)

If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If

Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
Windows(yeni_dosya_adı).Activate
Sheets(sayfaadı).Select
On Error Resume Next
Application.DisplayAlerts = False
Cells.Select
Selection.Copy
Windows(dosya_adı).Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveWindow.WindowState = xlMaximized
Windows(yeni_dosya_adı).Close
Application.CutCopyMode = False
MsgBox "işlem tamam"
End Sub