Find & Replace - All worksheets except one and with different Target column

Hi ALL,

I have vba code below, stored on Workbook(cs-asmemetric1.xls) that works on a specific worksheet and column. But when I copied this exact code to my Personal.xlsb it has an error on "Set Target = ThisWorkbook.Sheets("PLUG, HEX HEAD").Columns(55)", I guess the function ThisWorkbook.Sheets is not applicable in Personal.xlsb

What I want to achieve:
1. Copy all imperial size in column B (starts from B3 to last value)
2. Paste copied imperial size to row 3 of column with name "mmSize". Column "mmSize" is not fix position.
If possible add a condition: do not paste if row 3 of column "mmSize" is not blank/empty
3. Replace imperial size value in column "mmSize" to metric size from lookup table NomDiaMap.xlsx
4. Column "mmSize" shall be number stored as text only
5. repeat steps 1-4, on all worksheets except "Catalog Data"

Thank you in advance.

regards,
rxk

Code:

---

Sub Multi_FindReplace()
    Dim fndList As Variant
    Dim x As Long
    Dim Source As Workbook
    Dim Target As Range
    Dim MyPath As String
   
    MyPath = "G:\88 - Plant 3D stuffs\LookupTable\"  'Change to suit
   
    Set Target = ThisWorkbook.Sheets("PLUG, HEX HEAD").Columns(55)
    On Error Resume Next
    Set Source = Workbooks("NomDiaMap.xlsx")  ' If open
    If Not Source Is Nothing Then
        fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
    Else
        Set Source = Workbooks.Open(MyPath & "Test_Translate.xlsm")  'If closed
        fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
        Source.Close False
    End If
    On Error GoTo 0
    'Loop through each item in Array lists
    For x = LBound(fndList) To UBound(fndList)
            Target.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
            LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
    Next x
End Sub

---

Attachment 27181
Attachment 27182

I get what i need, but other ideas to make it faster are welcome.

Code:

---

Sub P3D_Batch_SizeImpToMetric_table()
    Dim fndList As Variant
    Dim x As Long
    Dim Source As Workbook
    Dim Target As Range
    Dim MyPath As String
    Dim SizesRep As Range
    Dim ws As Worksheet
    Dim colNum As Integer
    Dim rng As Range
    Dim rng1 As Range
   
    MyPath = "G:\88 - Plant 3D stuffs\LookupTable\"  'Change to suit
   
    Sheets(1).Activate
   
'  Start Macro to run for all worksheets "except Catalog Data"
    For Each ws In Worksheets
        Application.ScreenUpdating = False
        If ws.Name <> "Catalog Data" Then
        ws.Activate
   
'  start copy Imperial Size column
    Range("A2").Select
    Set rng = Cells.Find(What:="Sizes", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
    rng.Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
'  end copy Imperial Size column

'  start paste Imperial Size to Metric mmSize column
    Range("A2").Select
    Set rng = Cells.Find(What:="mmSize", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
    rng.Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
'  start paste Imperial Size to Metric mmSize column

'  start Replace Imperial to Metric Size from NomDiaMap.xlsx
    Set Target = Selection
    On Error Resume Next
    Set Source = Workbooks("NomDiaMap.xlsx")  ' If open
    If Not Source Is Nothing Then
        fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
    Else
        Set Source = Workbooks.Open(MyPath & "Test_Translate.xlsm")  'If closed
        fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
        Source.Close False
    End If
    On Error GoTo 0
    'Loop through each item in Array lists
    For x = LBound(fndList) To UBound(fndList)
            Target.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
            LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
    Next x
'  end Replace Imperial to Metric Size

    End If
Next ws
'  Start Macro to run for all worksheets "except Catalog Data"

End Sub

---

1.

Quote:

---

ThisWorkbook.Sheets is not applicable in Personal.xlsb

---

ThisWorkbook refers to the WB containing the macro

ActiveWorkbook refers to the WB that is 'active'

2. Usually you don't need to .Select an object like a Range in order to act on it

Code:

---

Worksheets("Sheet1").Range("A1").Copy Worksheets("Sheet2").Range("Z26")

---