2017-01-27 1 views
-2

Я копирование диапазона от одного листа к другому, используя следующий код:приложение определены или объект, определенная ошибка [при прохождении объекта Range к методу Range]

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 

В качестве кода иллюстрирует, я ищет уникальный ссылочный номер в листе «Отслеживание проектов», затем используя номер строки, чтобы определить диапазон для копирования. копируя этот диапазон и вставляя значения этого диапазона в новый лист. Тем не менее, я получаю ошибку приложения в строке, указанной в коде. Я проверял тройку, чтобы убедиться, что имена рабочих листов верны.

У меня такое чувство, что я должен знать, как я объявляю диапазон и как он пытается скопировать значения, но я не вижу, откуда он может выбросить эту ошибку.

Может ли кто-нибудь увидеть, откуда я буду получать эту ошибку, и что мне нужно сделать, чтобы решить эту проблему?

Спасибо.

+2

'Set copy_range = Range (...' должен быть как 'Set copy_range = ThisWorkbook.Worksheets ("Tracking Project"). Range (...'. Честно говоря, ваш код мог бы работать с явными ссылками на диапазон * везде *. –

+3

Здесь есть 937 существующих вопросов с тем же точным сообщением об ошибке. Сколько из них вы прочитали, чтобы узнать, есть ли у вас ответ? –

+0

@KenWhite - Я работаю над это за последние пару часов - и после первых 100 - 120 не дало подходящего решения для моего конкретного сценария, я предположил, что я делаю что-то еще глупое. Ни в коем случае нельзя сказать, что это конкретное решение не было 900+ других вопросы, но когда есть крайний срок для встречи, вы можете оправдывать бесплодные поиски так долго. – scb998

ответ

2

Извините, что вас избили, я редактировал заголовок вопроса, чтобы ваша конкретная проблема была идентифицирована. Вот попытка ответа ...

Это довольно сложно отлаживать без данных, но похоже, что copy_range уже имеет тип Range, вы, похоже, используете его в проблемной строке, как это было в диапазоне String, например, «A1 : С3" . Поэтому я переписал, вы можете перейти прямо к 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 
+0

Фантастический! спасибо за то, что помогли и решили проблему - я действительно ценю это. – scb998

Смежные вопросы