无法使用 VBA 将整行从一张纸复制到另一张纸

Question

我正在尝试使用 VBA 制作一个搜索工具，以查找用户输入的给定 SearchString 的所有工作表中的所有出现。它应该粘贴在名为“搜索”的工作表上相应列的不同工作表中找到此 SearchString 的整个行。如下图所示：

因此，应开始将在工作表 Free REQs 中找到的行粘贴到单元格 A11 中，并粘贴在连续的行中，直到在工作表 Free REQs 中找不到更多对应关系，然后应开始在工作表 Temporary 中找到的行粘贴在单元格 N11 中，以此类推所有工作表（不同工作表中的表格与搜索工作表中的相应表格具有相同的列数）。为此，我有以下代码（TableColumn 是 Search 表中每个表开始的列，例如，对于 Free REQ，它将是“B”）：

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each Sh In SheetNames
        TableColumn = GetTableBeginColumn(Sh)
        With Sheets(Sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                Do Until Loc Is Nothing
                    'Copy the data from the original source
                    .Rows(Loc.Row).EntireRow.Copy
                    'Paste it into the Search sheet
                    ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub

虽然，对于这一行：

ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)

我收到了错误：

尽管TableColumn & CurrentRow 对应于定义单个单元格的字符串。我在这里错过了什么？

Answer 1

试试这个小小的重构

Option Explicit

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow
    Dim sh As Variant
    Dim firstAddress As String

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each sh In SheetNames
        TableColumn = GetTableBeginColumn(sh)
        With Sheets(sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                firstAddress = Loc.Address '<--| store first found cell address
                Do
                    'Copy the data from the original source
                    Intersect(.Rows(Loc.Row).EntireRow, .UsedRange).Copy Destination:=Sheets("Search").Range(TableColumn & CurrentRow) '<--| copy only a "finite" amount of columns
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop While Loc.Address <> firstAddress '<--| loop until 'Find()' wraps back to first found cell
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub