Dim sheetName As String
sheetName = ActiveSheet.Name
Dim cellAddress As String
cellAddress = ActiveCell.Address
tr = Range(cellAddress).CurrentRegion.Rows.Count
tc = Range(cellAddress).CurrentRegion.Columns.Count
tt = Cells(5, 1).NumberFormatLocal
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = "Euro"
Dim newSheetName As String
newSheetName = ActiveSheet.Name
For i = 1 To tr
For j = 1 To tc
tt = Worksheets(sheetName).Cells(i, j).NumberFormatLocal
Worksheets(sheetName).Cells(i, j).Copy
Worksheets(sheetName).Paste Destination:=Worksheets(newSheetName).Cells(i, j)
If Left(tt, 1) = "$" Then
ttnew = Replace(tt, "$", "€")
Worksheets(newSheetName).Cells(i, j).NumberFormatLocal = ttnew
End If
Next j
Next i