Spped up find and Replace

[keresztesi]

Hi,

I have the following code for find and replace:

Sub CSERÉL()
Dim X As Long, WS As Worksheet, Words As Variant, Replacements As Variant
Words = Array("2017.08")
Replacements = Array("2017.09")
For Each WS In ActiveWindow.SelectedSheets
For X = LBound(Words) To UBound(Words)
WS.Cells.Replace What:=Words(X), Replacement:=Replacements(X), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
Next
End Sub

The problem is that it needs really a lot of time to do that.
There are 25-30 sheets in my xls and on all sheets about 800 rows.
It takes a while until it finishes.

Unfortunately there is no chance to open all the reference files to speed up that way.

Any suggestions how to speed up the process?

Thx

 

[keresztesi]

Even on a single sheet it takes a lot of time! I have about 30 sheets!

Somebody?