Всякий раз, когда мне нужно скопировать данные, я считаю невероятно полезным придерживаться краткой обработки переменных, то есть одной переменной для источника - независимо от (например, рабочей книги, рабочего листа, диапазона,ячейка, индекс строки, индекс столбца и т. д.) и одна для цели.
Во-вторых, я бы порекомендовал сохранять переменные как можно более закрытыми.Если вы хотите передать значение как результат Sub, замените его Sub на Function и позвольте результату быть возвращаемым значением этой функции.
Наконец, это также помогает сохранитькаждая подпрограмма макроса, которая явно не предназначена для вызова также из других макросов Private, так что у каждого макроса есть свой отдельный контекст в файле модуля.
При этом, я думаю, кодВы ищете выглядит примерно так:
Option Explicit
' Entry point of macro
Sub Import()
Dim SourceWb As Workbook
Dim TargetWb As Workbook
' Prevents Excel from showing the opening and closing
Application.ScreenUpdating = False
' The target is this workbook
Set TargetWb = ThisWorkbook
' Let the user select the workbook
Set SourceWb = OpenSourceWorkbook
If SourceWb Is Nothing Then
' The user has cancelled the selection.
' We can be fairly sure they'll assume that clicking "Cancel"
' cancels the operation, so we can just exit the macro
' without further notice.
Application.ScreenUpdating = True
Exit Sub
End If
If SourceWb Is TargetWb Then
MsgBox "Cannot copy from and to the same workbook." & vbCrLf & vbCrLf & _
"Cancelling the import.", vbExclamation, "Invalid source file"
Application.ScreenUpdating = True
Exit Sub
End If
' Store whether so far everything worked
Dim Success As Boolean
' Copy the desired data, but stop if something goes wrong
Success = CopyData(SourceWb, TargetWb, "Run_Map", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "Reporting_Map", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "Variable_Map", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "Product_Map_ETY", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "Subproduct_Map", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "Currency_Map", "A2:Z500")
If Success Then Success = CopyData(SourceWb, TargetWb, "FX_Map", "A2:Z500")
' Close the user-selected source workbook
Call SourceWb.Close(SaveChanges:=False)
If Success Then
MsgBox "All data was copied successfully.", vbInformation, "Success"
End If
' In the other case we triggered a message box earlier,
' so no need to report that again.
' Re-enable the screen updating - and we're done!
Application.ScreenUpdating = True
End Sub
Private Function OpenSourceWorkbook() As Workbook
Dim SelectedFilePath As Variant
SelectedFilePath = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=False)
If SelectedFilePath = False Then
' The user has cancelled the dialog
' Set the result to Nothing
Set OpenSourceWorkbook = Nothing
Else
' Open the file and set it as result
Set OpenSourceWorkbook = Workbooks.Open(SelectedFilePath)
End If
End Function
Private Function CopyData(SourceWb As Workbook, TargetWb As Workbook, _
WorksheetName As String, Range As String) As Boolean
Dim SourceWs As Worksheet
Dim TargetWs As Worksheet
Dim SourceArea As Range
Dim TargetArea As Range
' Try to obtain the source worksheet
Set SourceWs = TryGetWorksheetByName(SourceWb, WorksheetName)
If SourceWs Is Nothing Then
' Source worksheet not found. Report error and abort.
MsgBox "The file you selected does not appear to be a valid source for the data." & vbCrLf & _
"It does not have a worksheet named '" & WorksheetName & "'." & vbCrLf & vbCrLf & _
"Cancelling the import.", vbExclamation, "Invalid source file"
' Return failure
CopyData = False
Exit Function
End If
' Try to obtain the target worksheet
Set TargetWs = TryGetWorksheetByName(TargetWb, WorksheetName)
If TargetWs Is Nothing Then
' Target worksheet not found. Report error and abort.
MsgBox "Cannot copy the data to the target workbook since it" & vbCrLf & _
"does not have a worksheet named '" & WorksheetName & "'." & vbCrLf & vbCrLf & _
"Cancelling the import.", vbExclamation, "Invalid target file"
' Return failure
CopyData = False
Exit Function
End If
' Range to copy from and to
Set SourceArea = SourceWs.Range(Range)
Set TargetArea = TargetWs.Range(Range)
' Finally, copy the data
Call SourceArea.Copy(Destination:=TargetArea)
' Return success
CopyData = True
End Function
Private Function TryGetWorksheetByName(Wb As Workbook, WorksheetName As String) As Worksheet
Set TryGetWorksheetByName = Nothing
On Error Resume Next
Set TryGetWorksheetByName = Wb.Sheets(WorksheetName)
On Error GoTo 0
End Function