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