从用户定义的单元格开始,将一张工作表中已命名范围的单元格值复制到另一张工作表中

问题描述 投票:0回答:1

我有许多不同的单元格(每个单元都有一个唯一的名称),这些单元位于名为“主”的工作簿中的各个工作表中。通过将其工作表和范围名称与目标工作簿中包含“绘图代码”的单元格的内容进行匹配,可以选择要复制的源单元格。下面的宏专门将单元格“ 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。以下代码成功地从用户获取了指定的目标单元格,但是在粘贴范围时失败了。我知道我必须错误地定义了粘贴,但是无法计算出需要的内容。任何指导都将受到欢迎!

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
excel vba
1个回答
0
投票

我已经审查,更正并评论了您的代码。这是我工作的成果。

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)必须失败。但是,我要提醒您注意该范围的指定位置。 Type 8 InputBox大概定义了当前ActiveSheet上的范围。您的代码中没有证据表明可能是哪张纸。因此,您可能会对副本的最终位置感到惊讶。

我可能会

© www.soinside.com 2019 - 2024. All rights reserved.