范围类错误1004select方法失败

我不明白我在这里出了什么地方，任何帮助表示赞赏。 我试图剪切和粘贴任何有“解决”字的行到另一个电子表格，但是代码在循环开始时被阻塞在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