Cendrinne
Edit: I see that Paul also tidied up the code while I was posting. I think the wdFindStop could be a problem as the range may collapse as you progress through the code. It is possibly better to use wdFindContinue if you are encountering issues.
You should be able to clean up your code considerably. You started by defining a range and then completely ignored it by using Selection instead. Try this cleanup on your Part 1 code and study it before applying the same principles to your Part 2
Code:
Application.ScreenUpdating = False
Dim aTbl As Table, rngTable As Range
For Each aTbl In ActiveDocument.Tables
Set rngTable = aTbl.Range
With rngTable.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Color = wdColorBlue
.Format = True
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Text = "[$]{1}[0-9,.]{1;}"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
.Text = "[$\(]{2}[0-9,.]{1;}"
.Execute Replace:=wdReplaceAll
.Text = "([0-9]{1;})"
.Replacement.Text = "\1"
.Execute Replace:=wdReplaceAll
.Text = "([0-9,.]{2;})"
.Execute Replace:=wdReplaceAll
.Text = "([\(][0-9]{1;}[\)])"
.Execute Replace:=wdReplaceAll
.Text = "([\(][0-9,.]{2;}[\)])"
.Execute Replace:=wdReplaceAll
.Text = "(^=){1}"
.Execute Replace:=wdReplaceAll
.Text = "([\)])([\)])"
.Replacement.Text = "\2"
.Execute Replace:=wdReplaceAll
End With
Next aTbl
Another tip is to not be so liberal with your use of Application.ScreenUpdating = False
It is better to not do that until your code is fully debugged as it stops you from seeing what is going on as your macro runs and makes life difficult if the code fails at any point before you turn it on again.