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对象变量或未设置块变量”。

我知道可以通过更简单的编程来实现相同的结果，但是对于我的预期用途，它必须像上面显示的那样使用循环和“查找”功能完全工作。

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

您还可以使用复制粘贴

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

使用“查找”功能查找，复制和粘贴在不同的工作表中

2 个答案: