方法Select(运行-时间错误1004)

Method Select (run-time error 1004)

我想找到某个单元格并在单元格偏移量中插入一个值(从另一本书复制)。 我写了代码但是弹出错误

run time error 1004 select method range class failed

在代码行中: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\БАЗА ДАННЫХ\прошлый сезон\Англия-ое место.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

您正在尝试 select 在非活动工作表中进行范围调整,这就是原因。
尝试先激活它或按照 Shai 的建议进行操作。

不需要Activate book2.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\БАЗА ДАННЫХ\прошлый сезон\Англия-ое место.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