在另一个工作簿中查找值并复制/粘贴一系列单元格

Question

我是 VBA 新手，我从论坛中找到的代码和录制的宏生成的代码拼凑而成。我认为它很接近，但是经过大量搜索后我无法弄清楚一个问题。感谢您的帮助。

我在 wb1 中有一个工作表，在单元格 B3 中有一个值，我想在 wb2 中搜索该值（跨多个工作表）。找到值后，我想在工作表中选择找到该值的单元格范围，然后将其复制回 wb1。

代码成功找到wb2中的值。它选择一系列单元格并将其复制回 wb1。问题是它没有从所需的工作表（实际找到该值的位置）中选择单元格。它从打开的工作表 wb2 中选择单元格范围。例如，如果 Excel 打开 wb2 到 Sheet1，并且在 Sheet3 中找到了我的 Value，它仍然会从 Sheet1 复制范围。

我需要它来查找工作表中的单元格，然后从 那个 工作表中复制。这就是我目前所拥有的（我有几个消息框来查看代码是否正确地循环通过工作表并找到一些东西）：

Sub PasteTemplate()

    Dim wb1 As Workbook
    Set wb1 = ThisWorkbook
    Dim Dest As Worksheet
    Set Dest = ActiveSheet
    Dim FindValue As String
    FindValue = Range("B3").Value
    Dim PasteHere As Range
    Set PasteHere = Range("A5")
        
    'This section opens wb2 if it is not already open
    Dim fStatus As Long
        Err.Clear
        On Error Resume Next
    Set wb2 = Application.Workbooks.Open(filename:="Templates.xlsx", UpdateLinks:=False)
        fStatus = Err
        On Error GoTo 0
        If fStatus Then
            Set wb2 = Application.Workbooks.Open(filename:="Templates.xlsx", UpdateLinks:=False)
        End If
        
    Dim FoundValue As Range
        
        For Each Sheet In wb2.Sheets
            With Sheet.Columns("B")
                Set FoundValue = .Find(What:=FindValue, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=True, SearchFormat:=False)
                    If FoundValue Is Nothing Then
                        msgbox "Value not found in " & Sheet.Name
                        End If
                    If Not FoundValue Is Nothing Then
                        msgbox "Found the value in " & Sheet.Name
                        Range("A1:Z100").Select '//Where the problem is. It selects the range in the sheet where wb2 was opened to
                        Application.CutCopyMode = False
                        Selection.Copy
                    End If
            End With
        Next
        
    wb1.Activate
    PasteHere.Select
    ActiveSheet.Paste

End Sub

Answer 1

只有Range()。与拥有ActiveSheet.Range() 相同。因此，指定工作表总是好的。这也适用于变量，例如PasteHere

另外，how to avoid using select 的必填链接。

无法测试，但可能是这样的：

由于您使用的是for each 循环，我们将当前工作表作为变量准备好在引用范围时使用。

  ...  
    For Each Sheet In wb2.Sheets
        With Sheet.Columns("B")
            Set FoundValue = .Find(What:=FindValue, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=True, SearchFormat:=False)
                If FoundValue Is Nothing Then
                    msgbox "Value not found in " & Sheet.Name
                    End If
                If Not FoundValue Is Nothing Then
                    msgbox "Found the value in " & Sheet.Name
                    Sheet.Range("A1:Z100").Copy PasteHere
                End If
        End With
    Next
End Sub