copy cell values of named range in one sheet to another sheet starting at a cell defined by the user

Question

I have a number of different cells (each assigned a unique name) located in various worksheets contained in a workbook named "Master". The source cells to be copied are selected by matching their worksheet and range name to the contents of a cell containing a Drawingcode in the destination workbook. The following macro, which specifically defines cell "X6" as the starting cell for the cells to be copied in the destination worksheet ("Drawing") from which the macro is called works fine:

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

Instead of a using the predefined cell ("X6") as the destination starting cell to be copied to, I want to have the user dictate the starting cell instead using an InputBox. The following successfully gets the specified destination cell from the user but fails when it comes to pasting the range. I know I must be defining the Paste incorrectly but cannot work out what it needs to be. Any guidance would be welcome!

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

Variatus Variatus · Accepted Answer · 2020-03-16T04:19:19

I have reviewed, corrected and commented your code. Here is the fruit of my work.

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

The error seems to be that DockTopLeftCell is already a range. Therefore Range(DockTopLeftCell) must fail. However, I wish to caution you to be more careful of where that range is specified. The Type 8 InputBox presumably defines the range on the currently ActiveSheet. There is no evidence in your code which sheet that might be. So you might be surprised where the copy ends up.

I would probably take the address of the cell specified and use it on the sheet I want, like Set DockTopLeftCell = MySheet.Range(DockTopLeftCell.Address). Then it wouldn't matter on which sheet the address was created.

copy cell values of named range in one sheet to another sheet starting at a cell defined by the user

1 Answers