Ошибка 1004 метод выбора класса диапазона не удался

Question

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

Sub FindString() 
    Dim SearchString As String 
    Dim SearchRange As Range, cl As Range 
    Dim FirstFound As String 
    Dim sh As Worksheet 

    'Open first item to search and paste destination 
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\Markerstudy.xlsx" 
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\solved results.xlsx" 
    Workbooks("markerstudy").Activate 

    ' Set Search value 
    SearchString = "solved" 
    Application.FindFormat.Clear 
    ' loop through all sheets 
    For Each sh In ActiveWorkbook.Worksheets 
     ' Find first instance on sheet 
     Set cl = sh.Cells.Find(What:=SearchString, _ 
      After:=sh.Cells(1, 1), _ 
      LookIn:=xlValues, _ 
      LookAt:=xlPart, _ 
      SearchOrder:=xlByRows, _ 
      SearchDirection:=xlNext, _ 
      MatchCase:=False, _ 
      SearchFormat:=False) 
     If Not cl Is Nothing Then 
      ' if found, remember location 
      FirstFound = cl.Address 
      ' format found cell 
      Do 
       cl.Activate 
       ActiveCell.EntireRow.Cut 
       Workbooks("solved results").Activate 
       Range("A1").Select 
       If ActiveCell <> "" Then 
        ActiveCell.Offset(1, 0).Select 
        ActiveCell.PasteSpecial xlPasteAll 
       Else 
        ActiveCell.PasteSpecial xlPasteAll 
       End If 

       ' find next instance 
       Set cl = sh.Cells.FindNext(After:=cl) 
       ' repeat until back where we started 
      Loop Until FirstFound = cl.Address 
     End If 
    Next 
End Sub 

Answer 1

Вы должны активного листа первого, с cl.Parent.Activate

Sub FindString() 
    Dim SearchString As String 
    Dim SearchRange As Range, cl As Range 
    Dim FirstFound As String 
    Dim sh As Worksheet 

    'Open first item to search and paste destination 
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\Markerstudy.xlsx" 
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\solved results.xlsx" 
    Workbooks("markerstudy").Activate 

    ' Set Search value 
    SearchString = "solved" 
    Application.FindFormat.Clear 
    ' loop through all sheets 
    For Each sh In ActiveWorkbook.Worksheets 
     ' Find first instance on sheet 
     Set cl = sh.Cells.Find(What:=SearchString, _ 
      After:=sh.Cells(1, 1), _ 
      LookIn:=xlValues, _ 
      LookAt:=xlPart, _ 
      SearchOrder:=xlByRows, _ 
      SearchDirection:=xlNext, _ 
      MatchCase:=False, _ 
      SearchFormat:=False) 
     If Not cl Is Nothing Then 
      ' if found, remember location 
      FirstFound = cl.Address 
      ' format found cell 
      Do 
       cl.Parent.Activate 
       cl.Activate 
       ActiveCell.EntireRow.Cut 
       Workbooks("solved results").Activate 
       Range("A1").Select 
       If ActiveCell <> "" Then 
        ActiveCell.Offset(1, 0).Select 
        ActiveCell.PasteSpecial xlPasteAll 
       Else 
        ActiveCell.PasteSpecial xlPasteAll 
       End If 

       ' find next instance 
       Set cl = sh.Cells.FindNext(After:=cl) 
       ' repeat until back where we started 
      Loop Until FirstFound = cl.Address 
     End If 
    Next 
End Sub