Question

我使用以下代码将范围从一个工作表复制到下一个工作表：

Private Sub btn_Milestones_Click()
Dim projectref As String
Dim savelocation As String
Dim projectSearchRange As Range
Dim LastRow As Integer
Dim NewWorkbook As Workbook
Dim copy_range As Range

'set search value (porject key - unique)
projectref = cmb_Project.Value

Application.ScreenUpdating = False
Workbooks("Project tracker spreadsheet VBA").Activate
'find the project reference in the tracking spreadsheet
With Sheets("Project Tracking")
    Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
    If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
        LastRow = projectSearchRange.Row
        'file directory to save the new workbook in
        savelocation = .Cells(LastRow, 5).Value
    Else '<-- find was unsuccessful
        MsgBox "Unable to find " & projectref
        Exit Sub
    End If
End With
Set copy_range = Range(Cells(LastRow, 11), Cells(LastRow, 34))

Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
End Sub

正如代码所示，我正在寻找＆＃34;项目跟踪＆＃34;中的唯一参考编号。工作表，然后使用行号来定义要复制的范围。复制该范围并将该范围的值粘贴到新工作表中。但是，我在代码中指示的行上收到应用程序错误。我已进行三重检查，以确保工作表名称正确无误。

我觉得这与我宣布范围的方式以及它是如何尝试复制值的方式有关，但是我无法看到它从哪里抛出此错误。

任何人都可以看到我将从哪里获得此错误，以及我需要做些什么来解决它？

感谢。

Answer 1

很抱歉，你被打败了，我编辑了问题标题，以便确定您的具体问题。这是一个尝试过的答案......

在没有数据的情况下进行调试非常困难，但看起来copy_range已经是Range类型，你似乎在问题行上使用它，就像String范围表达式一样“A1 ：C3" 。所以我改写了，你可以直接去copy_range.Copy。

评论者是正确的，完整的资格证明有助于澄清问题，所以我做了一些完整的资格但不是全部。

试试这个

Option Explicit

Private Sub btn_Milestones_Click()
    Dim projectref As String
    Dim savelocation As String
    Dim projectSearchRange As Range
    Dim LastRow As Integer
    Dim NewWorkbook As Workbook
    Dim copy_range As Range


    'set search value (porject key - unique)
    projectref = cmb_Project.Value

    Application.ScreenUpdating = False
    Workbooks("Project tracker spreadsheet VBA").Activate

    Dim wbSource As Excel.Workbook
    Set wbSource = Workbooks("Project tracker spreadsheet VBA")

    'find the project reference in the tracking spreadsheet
    With Sheets("Project Tracking")
        Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
        If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
            LastRow = projectSearchRange.Row
            'file directory to save the new workbook in
            savelocation = .Cells(LastRow, 5).Value
        Else '<-- find was unsuccessful
            MsgBox "Unable to find " & projectref
            Exit Sub
        End If
    End With

    Dim wsMilestoneTempate As Excel.Worksheet
    Set wsMilestoneTempate = wbSource.Worksheets("Milestone_Template")

    Set copy_range = wsMilestoneTempate.Range(wsMilestoneTempate.Cells(LastRow, 11), wsMilestoneTempate.Cells(LastRow, 34))
    copy_range.Copy
    ''''Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
    Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
End Sub

应用程序定义或对象定义错误[将Range对象传递给Range方法时]

1 个答案: