Amend all currency/number formats as per one cell currency format

Hi

I have a macro which change currency of selected cells in a worksheet based on the currency format of a cell called "TSI"

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Rg As Range



If Target.CountLarge > 1 Then Exit Sub
If Intersect([TSI], Target) Is Nothing Then Exit Sub
Set Rg = Range("C22:D29,E22:F29,C36:F44,C48:F54,C61:F69,C75:F81,C83:D87,F87,D89,")


Select Case [TSI].NumberFormat

   Case "#,##0.00 [$USD]": Rg.NumberFormat = "#,##0.00 [$USD]"
   Case "#,##0.00 [$EUR]": Rg.NumberFormat = "#,##0.00 [$EUR]"
End Select

End Sub

This works fine, but i would like to do it easier to change all number /currency format in all the worksheets (excluding percentage and dates format of course) as per cell "TSI" currency format, can someone help?

thank you there was some inversion in your code that i corrected, however i would like to run it in the active worsheet meaning

My workbook has 3 worksheet, i kepp only the relevant one deleting the useless ones for my case,
Each worksheet has a cell named "TSI" on which should be based all the currency formated cells in the worsheet

if in the active worksheet, upon changed in TSI value/currency format(EUR or else), then all the numbered formatted cells in the active worsheet sshould have same format than "TSI"
it should apply only on yhe number formatted cells not on the other ones fromatted for example as date or percentage

i guess i should put the code under each worksheet since some will be deleted

could you help me

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim cell As Range, rngNumbers As Range
Dim strFind As String, strReplace As String

Const conUSD = "[$USD] #,##0.00"
Const conEUR = "[$EUR] #,##0.00"
    
    'each time "TSI" is modified (number and/or currency)
    strReplace = Range("TSI").NumberFormat

        'find and apply macro on each cells formatted as "number" in the worksheet
          Set rngNumbers = UsedRange.Cells.SpecialCells(xlCellTypeConstants, 1)
        If Not rngNumbers Is Nothing Then
            For Each cell In rngNumbers.Cells
                If cell.NumberFormat = strFind Then cel.NumberFormat = strReplace
            Next cell
        End If
   
    
    
End Sub

I managed to do it, each time "TSI" value change, below macro looks for all the cells numbered formatted (excluding percentage) change the format of the cell as per TSI format

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim cel As Range, rngNumbers As Range
Dim strFind As String, strReplace As String

Const conUSD = "#,##0.00 [$USD]"
Const conEUR = "#,##0.00 [$EUR]"
    
    
    If Not Intersect(Target, Target.Worksheet.Range("TSI")) Is Nothing Then
    strReplace = Range("TSI").NumberFormat
       
        Set rngNumbers = Cells.SpecialCells(xlCellTypeConstants, 1)
        If Not rngNumbers Is Nothing Then
            For Each cel In ActiveSheet.UsedRange
                If IsNumeric(cel) = True And cel.NumberFormat <> "0.0000%" Then cel.NumberFormat = strReplace
            Next cel
        End If
        
     End If
End Sub