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

(solved)-–-copy-cell-values-of-named-range-in-one-sheet-to-another-sheet-starting-at-a-cell-defined-by-the-user

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

Leave a Reply

Your email address will not be published. Required fields are marked *