есть такой код
Function export(FileName) 'подпрограмма

PathFolder = ThisWorkbook.Path 'Путь к файлу исходнику присланного с района
SheetName = "РММ" 'Имя листа в файле исходнике на котором нужные данные
Set x = [A1:B2] 'Диапазон с данными для копирования
With x
.ClearContents
.Formula = "='" & PathFolder & "\[" & FileName & "]" & SheetName & "'!" & x.Address
.Value = .Value
End With

For Each ws In x 'удаление нулей, х - диапазон проверяемого массива
If ws.Value = 0 Then
ws.Value = ""
End If
Next ws

End Function

Вопос как сделать, чтоб копировалось не в тот же диапазон, а к приеру в D1:C2

Решил задачу так

Sub Экспорт()

Dim x As Range, vstavka As Range, SheetName As String, FileName As String, PathFolder As String
Application.ScreenUpdating = False
'1
ThisWorkbook.Sheets("raschet").Select 'выбираем страницу куда переносим даные
Range("j10:ha106").ClearContents
For a = 10 To 200
If Cells(7, a) = 0 Then GoTo 10 'если не заполнена ячейка следующей даты то конец списка

FileName = Cells(7, a) & ".xls" 'Имя файла ежедневного отчёта по любому объекту

FilePath = ThisWorkbook.Path & "\Sinquena-3\" 'Путь к папке объекта Sinquena-3
Set vstavka = Range(Cells(10, a), Cells(26, a))
export FilePath, FileName, vstavka 'вызов подпрограммы export


FilePath = ThisWorkbook.Path & "\Los_Pozones\" 'Путь к папке объекта Los_Pozones
Set vstavka = Range(Cells(30, a), Cells(46, a))
export FilePath, FileName, vstavka 'вызов подпрограммы export

FilePath = ThisWorkbook.Path & "\Las_Palmas\" 'Путь к папке объекта Las_Palmas
Set vstavka = Range(Cells(50, a), Cells(66, a))
export FilePath, FileName, vstavka 'вызов подпрограммы export

FilePath = ThisWorkbook.Path & "\Ciudad_Varina\" 'Путь к папке объекта Ciudad_Varina
Set vstavka = Range(Cells(70, a), Cells(86, a))
export FilePath, FileName, vstavka 'вызов подпрограммы export

FilePath = ThisWorkbook.Path & "\Carlos_Marquez\" 'Путь к папке объекта Carlos_Marquez
Set vstavka = Range(Cells(90, a), Cells(106, a))
export FilePath, FileName, vstavka


Next a
10 MsgBox "Импорт данных завершён"
1000 End Sub
Function export(FilePath, FileName, vstavka) 'подпрограмма

If Dir$(FilePath & FileName) <> "" Then 'проверка на существование файла
GoTo 20 ' данный файл существует
Else
MsgBox "Данный файл не существует "
End
End If

20 SheetName = "rus" 'Имя листа в файле исходнике на котором нужные данные
y = 29 'константа, точка отсчёта в ежедневных отчётах


For Each ws In vstavka 'Диапазон для заполнения данными
ws.Value = "='" & FilePath & "[" & FileName & "]" & SheetName & "'!" & "G" & y
y = y + 1
ws.Value = ws.Value
If ws.Value = 0 Then 'удаление нулей
ws.Value = ""
End If
Next ws
GoTo 40


40 End Function