Find Match, Copy/Paste to a closed worksheet in workbook

[paspuggie48]

I've found another helpful bit of code here at VBA Express (I can't post the link as I am new here).

Here is the code, which I slightly modified for my needs:-

Sub CopyPasteWithString()    
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws As Worksheet
    Dim filePath As String
    Dim searchValue As Variant
    Dim myRange As Range
    Dim fCell As Range
    
    filePath = "C:\Personal\EXCEL\Paul2.xlsx"
    
    Set wb1 = ActiveWorkbook
    Set myRange = ActiveSheet.Range("B1:H1")
    searchValue = ActiveSheet.Range("A1").Value
    
    Application.ScreenUpdating = False
     
     'Open wb2
    Set wb2 = Workbooks.Open(filePath)
     
     'Search and find
    Set fCell = Nothing
    
    For Each ws In wb2.Worksheets
        Set fCell = ws.Cells.Find(searchValue)
         'Stop when we find the value
        If Not fCell Is Nothing Then
            myRange.Copy
            fCell.Offset(, 1).PasteSpecial
            Exit For
        End If
    Next ws
    
    With wb2
        Application.CutCopyMode = False
    End With
    
    wb2.Close True
    
    Application.ScreenUpdating = True
End Sub

The code copies the Range B1:H1 in wb1 and from the cell value in A1, it opens wb2, finds the matching string value, then pastes the range with an offset of 1 cell to the right.

The code works brilliantly but it searches every Worksheet in the closed Workbook. I just want to search in one Worksheet only (example "Sheet2") and ensure it only searches Col A in that Worksheet. Reason being is the value in wb1, Cell A1 is on other worksheets and other columns in wb2 and I need it to look in Sheet2, Col A only.

How do I modify the code to suit?

[paspuggie48]

Had a little think and I'm not sure if it is correct but the following edit seems to work. I copied multiple worksheets with similar data and tested it and it copied the range to the right Worksheet and Column.

If anyone feels it can be re-written to be more efficient/professional then please let me know.

Sub CopyPaste()    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim filePath As String
    Dim searchValue As Variant
    Dim myRange As Range
    Dim myRange2 As Range
    Dim fCell As Range
    
    filePath = "C:\Personal\EXCEL\Paul2.xlsx"
    
    Set wb1 = ActiveWorkbook
    Set myRange = ActiveSheet.Range("B1:H1")
    searchValue = ActiveSheet.Range("A1").Value
    
    Application.ScreenUpdating = False
     
     'Open wb2
    Set wb2 = Workbooks.Open(filePath)
     
     'Search and find
    Set fCell = Nothing
    
        Set ws2 = Worksheets("Sheet2")
        Set myRange2 = Range("A:A")
        Set fCell = ws2.Cells.Find(searchValue)
         'Stop when we find the value
        If Not fCell Is Nothing Then
            myRange.Copy
            fCell.Offset(, 1).PasteSpecial
        End If
    
    With wb2
        Application.CutCopyMode = False
    End With
    
    wb2.Close True
    
    Application.ScreenUpdating = True
End Sub