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

您试图在非活动工作表中选择范围，这就是原因尝试先激活它，或按照Shai的建议进行。

Answer 2

不需要Activate book2.Worksheets("54")以及之后r.Offset(6, 5).Select并再次使用Selection，您应该尝试保留Copy＆gt;＆gt; 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

方法选择（运行时错误1004）

2 个答案: