Поиск, копирование и вставка в разные листы с помощью функции «Найти»

Question

С помощью следующего макроса я пытался найти в worksheet ("Sheet11") определенный заголовок, скопировать строки под ним, используя loop (x = 0 to 10), найти тот же заголовок в другом worksheet ("Sheet22") и вставить скопированный материал в точно такой же заголовок.

Sub FindCopyPasteV8()

Dim FindH1 As Range

Dim TestR1 As Range
Dim TestR2 As Range

Dim StartRow1 As Long
Dim StartColumn1 As Long
Dim StartRow2 As Long
Dim StartColumn2 As Long

Dim x As Long

   With Sheets("Sheet11").Range("A:FF")

      Set FindH1 = .Find(What:="Header 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

   End With

   With Sheets("Sheet22").Range("A:FF")

      Set TestR1 = .Find(What:="Header 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

      For x = 0 To 10

         StartColumn1 = TestR1.Column
         StartColumn2 = FindH1.Column

         StartRow1 = TestR1.Row + x
         StartRow2 = FindH1.Row + x

         Set TestR1 = Sheets("Sheet22").Cells(StartRow1, StartColumn1)
         Set TestR2 = Sheets("Sheet11").Cells(StartRow2, StartColumn2)

         TestR2.Copy TestR1

     Next x

  End With

End Sub

Это не работает, и я не знаю почему. Я получаю сообщение об ошибке в строке StartColumn1 = TestR1.Column Сообщение об ошибке: «объектная переменная ошибка 91 или переменная блока не установлена».

Я знаю, что тот же результат может быть достигнут при более простом программировании, но для моего предполагаемого использования он должен работать точно , как показано выше, с циклом и функцией Find.

Answer 1

Это просто говорит о том, что диапазон TestR1 не был установлен, поэтому вы не можете получить доступ к его свойствам.

При использовании метода Find всегда проверяйте, найден ли диапазон, который вы ищете, прежде чем продолжить.

И вы можете сделать это так ...

With Sheets("Sheet22").Range("A:FF")
    Set TestR1 = .Find(What:="Header 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)
    If Not TestR1 Is Nothing Then
        For x = 0 To 10
            StartColumn1 = TestR1.Column
            StartColumn2 = FindH1.Column

            StartRow1 = TestR1.Row + x
            StartRow2 = FindH1.Row + x

            Set TestR1 = Sheets("Sheet22").Cells(StartRow1, StartColumn1)
            Set TestR2 = Sheets("Sheet11").Cells(StartRow2, StartColumn2)

            TestR2.Copy TestR1
        Next x
    Else
        MsgBox "Header 1 was not found on Sheet22.", vbExclamation
        Exit Sub
    End If
End With

Answer 2

Вы также можете использовать copy-paste

Option Explicit

Sub FindCopyPasteV8()

    Dim FindH1 As Range, TestR1 As Range
    Dim LastRow11 As Long, lastRow22 As Long

    Dim ws11 As Worksheet, ws22 As Worksheet

    With ThisWorkbook
        Set ws11 = .Worksheets("Sheet11")
        Set ws22 = .Worksheets("Sheet22")
    End With

    'Eliminate searching range to search in the first row only
    Set FindH1 = ws11.Range("A1:FF1").Find(What:="Header 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

    'If Header 1 found in Sheet11
    If Not FindH1 Is Nothing Then

        Set TestR1 = ws22.Range("A1:FF1").Find(What:="Header 1", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

        'If Header 1 found in Sheet22
        If Not TestR1 Is Nothing Then
            'Find last row of the column where Header 1 found in Sheet11
            LastRow11 = ws11.Cells(ws11.Rows.Count, FindH1.Column).End(xlUp).Row
            'Find last row of the column where Header 1 found in Sheet22
            lastRow22 = ws22.Cells(ws11.Rows.Count, FindH1.Column).End(xlUp).Row
            'Copy range from sheet11
            ws11.Range(ws11.Cells(2, FindH1.Column), ws11.Cells(LastRow11, FindH1.Column)).Copy
            'Paste range to sheet22
            ws22.Cells(lastRow22 + 1, TestR1.Column).PasteSpecial Paste:=xlPasteValues
        Else
            'If Header not found in Sheet22
            MsgBox "Header 1 was not found on Sheet22.", vbExclamation
        End If

    Else
        'If Header 1 not found in Sheet11
        MsgBox "Header 1 was not found on Sheet11.", vbExclamation
    End If

End Sub