скопировать значения ячеек именованного диапазона на одном листе на другой лист, начиная с ячейки, определенной пользователем

Question

У меня есть несколько разных ячеек (каждой из которых присваивается уникальное имя), расположенных в разных листах, содержащихся в книге с именем «Мастер». Исходные ячейки для копирования выбираются путем сопоставления их листа и диапазона с содержимым ячейки, содержащей код чертежа в целевой книге. Следующий макрос, который определенно определяет ячейку «X6» как начальную ячейку для ячеек, которые будут скопированы на листе назначения («Рисование»), из которого вызывается макрос, работает нормально:

Option Explicit
Sub Copy_DOD()  'Copy specified named range

Dim dws, sws As Worksheet ' Destination and source worksheets
Dim swb As Workbook ' Source workbook
Dim DrawingCode, swsName As String 

Set dws = Worksheets("Drawing")
Set swb = Workbooks("Master.xlsm")

With dws

    Application.ScreenUpdating = False


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get Drawing Code
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    DrawingCode = dws.Range("DrawingCode")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Source Worksheet - DrawingCode up to character "x" 
    ' e.g code of 1234x56 produces worksheet name "1234" 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    swsName = Left(DrawingCode, (InStr(DrawingCode, "x")) - 1)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy Cells to Destination sheet
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   swb.Worksheets(swsName).Range(DrawingCode).Copy Range("X6")

End With

End Sub

Вместо используя предопределенную ячейку ("X6") в качестве начальной ячейки назначения, в которую нужно скопировать, я хочу, чтобы пользователь диктовал начальную ячейку вместо использования InputBox. Следующее успешно получает указанную ячейку назначения от пользователя, но завершается неудачно, когда дело доходит до вставки диапазона. Я знаю, что, должно быть, неправильно определяю Paste, но не могу понять, каким он должен быть. Любое руководство будет приветствоваться!

Option Explicit
Sub Copy_DOD()  'Copy specified named range

Dim dws, sws As Worksheet ' Destination and source worksheets
Dim swb As Workbook ' Source workbook
Dim DrawingCode, swsName As String 
Dim DockTopLeftCell As Range
Dim dTopLeftRow, dTopLeftColumn As Integer

Set dws = Worksheets("Drawing")
Set swb = Workbooks("Master.xlsm")

With dws

    Application.ScreenUpdating = False
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get the top left cell for the dock drawing and determine row and column values
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        On Error Resume Next
        Application.DisplayAlerts = False
        Set DockTopLeftCell = (Application.InputBox("Enter the cell to be the top left corner of the dock drawing (DO NOT GO LESS THAN CELL X6)", Type:=8))
        Application.DisplayAlerts = True
        On Error GoTo 0
        If DockTopLeftCell Is Nothing Then Exit Sub
            dTopLeftRow = DockTopLeftCell.Row            ' Set dock drawing row origin
            dTopLeftColumn = DockTopLeftCell.Column      ' Set dock drawing column origin

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get Drawing Code
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    DrawingCode = dws.Range("DrawingCode")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Source Worksheet - DrawingCode up to character "x" 
    ' e.g code of 1234x56 produces worksheet name "1234" 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    swsName = Left(DrawingCode, (InStr(DrawingCode, "x")) - 1)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy Cells to Destination sheet
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    swb.Worksheets(swsName).Range(DrawingCode).Copy Range(DockTopLeftCell)
    'swb.Worksheets(swsName).Range(DrawingCode).Copy Range("X6")

End With

End Sub

Answer 1

Я просмотрел, исправил и прокомментировал ваш код. Вот плод моей работы.

Sub Copy_DOD_2()  'Copy specified named range

    Dim sWb As Workbook                         ' Source workbook
    ' if no data type is prescribed VBA assumes Variant
    ' VBA does NOT assume the data type specified for the
    ' last item in a line.
    Dim dWs As Worksheet, sWs As Worksheet      ' Destination and source worksheets
    Dim DrawingCode As String, sWsName As String
    Dim DockTopLeftCell As Range
'    Dim dTopLeftRow As Long, dTopLeftColumn As Long

    Set sWb = Workbooks("Master.xlsm")
    Set dWs = Worksheets("Drawing")         ' this Ws is in the ActiveWorkbook
                                            ' maybe "Master", perhaps another

    Application.ScreenUpdating = False

    With dWs

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Get the top left cell for the dock drawing and determine row and column values
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Application Alerts provide useful help in this case.
        On Error Resume Next
        Set DockTopLeftCell = Application.InputBox( _
                             "Enter the cell to be the top left corner " & _
                             "of the dock drawing" & vbCr & _
                             "(DO NOT GO LESS THAN CELL X6)", _
                             "Dock drawing cell", "X6", Type:=8)
        If DockTopLeftCell Is Nothing Then Exit Sub

        On Error GoTo 0
'            dTopLeftRow = DockTopLeftCell.Row            ' Set dock drawing row origin
'            dTopLeftColumn = DockTopLeftCell.Column      ' Set dock drawing column origin

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Get Drawing Code
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        DrawingCode = dWs.Range("DrawingCode").Value

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Determine Source Worksheet - DrawingCode up to character "x"
        ' e.g code of 1234x56 produces worksheet name "1234"
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        sWsName = Left(DrawingCode, (InStr(DrawingCode, "x")) - 1)

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Copy Cells to Destination sheet
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        sWb.Worksheets(sWsName).Range(DrawingCode).Copy DockTopLeftCell
        'swb.Worksheets(swsName).Range(DrawingCode).Copy Range("X6")

    End With

    Application.ScreenUpdating = True
End Sub

Ошибка, похоже, в том, что DockTopLeftCell уже диапазон. Поэтому Range(DockTopLeftCell) должен потерпеть неудачу. Однако я хочу предупредить вас, чтобы вы были более осторожны с указанным диапазоном. InputBox типа 8 предположительно определяет диапазон в текущем ActiveSheet. В вашем коде нет доказательств того, какой лист это может быть. Поэтому вы можете быть удивлены тем, где заканчивается копия.

Я бы, вероятно, взял адрес указанной ячейки и использовал бы его на нужном мне листе, например Set DockTopLeftCell = MySheet.Range(DockTopLeftCell.Address). Тогда не имеет значения, на каком листе был создан адрес.