메서드 선택 (런타임 오류 1004)

Question

특정 셀을 찾고 해당 셀의 셀 오프셋에 값 (다른 책에서 복사)을 삽입하고 싶습니다. 나는 코드를 작성하지만 오류가 런타임 오류 1004 개 선택 방법 범위 클래스는 코드 행의

실패

팝업 : r.Offset(6, 5).Select

Sub связатьцифирь3() 

    Dim book1 As Workbook 
    Dim book2 As Workbook 
    Dim r As Range 
    Dim firstAddress As String 

    Set book1 = Workbooks.Open("E:\Super M\Проект ставки\Решение\цифирь.xlsx") 
    Set book2 = Workbooks.Open("E:\Super M\Проект ставки\Поиск решения\Усов 4\БАЗА ДАННЫХ\прошлый сезон\Англия\1-ое место\54.xlsx") 
    'переходим в активную страницу откуда надо скопировать данные' 
    book2.Worksheets("54").Activate 
    Range("AP100").Copy 

    'ищемс 
    With book1.Worksheets("Лист1").Range("A1:CV808") 

     Set r = .Find(What:="54") 
     If Not r Is Nothing Then 
      firstAddress = r.Address 
      Do 
       'условие для страны 
       If r.Offset(3, 0).Text = "Англия" Then 
        r.Offset(6, 5).Select 
        Selection.PasteSpecial Paste:=xlPasteValues 
       End If    
       Set r = .FindNext(r)    
      Loop While Not r Is Nothing And r.Address <> firstAddress 
     End If 
    End With 

End Sub 

Answer 1

이 Activatebook2.Worksheets("54") 할 필요가 없습니다, 나중에 r.Offset(6, 5).Select 다시 Selection를 사용하여, 당신은 당신이 할 수있는대로 Copy >>Paste 가깝게 유지하려고한다 :

book2.Worksheets("54").Range("AP100").Copy 
r.Offset(6, 5).PasteSpecial xlPasteValues 

코드

Sub связатьцифирь3() 

    Dim book1 As Workbook 
    Dim book2 As Workbook 
    Dim r As Range 
    Dim firstAddress As String 

    Set book1 = Workbooks.Open("E:\Super M\Проект ставки\Решение\цифирь.xlsx") 
    Set book2 = Workbooks.Open("E:\Super M\Проект ставки\Поиск решения\Усов 4\БАЗА ДАННЫХ\прошлый сезон\Англия\1-ое место\54.xlsx") 

    'ищемс 
    With book1.Worksheets("Лист1").Range("A1:CV808") 

     Set r = .Find(What:="54") 
     If Not r Is Nothing Then 
      firstAddress = r.Address 
      Do 
       'условие для страны 
       If r.Offset(3, 0).Value2 = "Англия" Then 
        book2.Worksheets("54").Range("AP100").Copy 
        r.Offset(6, 5).PasteSpecial xlPasteValues 
       End If 
       Set r = .FindNext(r) 
      Loop While Not r Is Nothing And r.Address <> firstAddress 
     End If 
    End With 

End Sub 

Answer 2

당신은 범위를 선택하려고 비활성 워크 시트에서는 이것이 이유입니다.
먼저 활성화하거나 Shai가 제안한대로 해보십시오.