[kapetang]

Καλησπέρα

Δημήτρη, αφού η αντιγραφή γίνεται πάνω στην περιοχή προέλευσης ο κώδικας θα μπορούσε να απλοποιηθεί στον ακόλουθο:

Sub ReplaceMultiRecursive()
'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion
'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά
'στα οποία θέλουμε να γίνουν αλλαγές
'-----------------------------------------------------------------------------------
    Dim i As Long, j As Long
    Dim rngSource As Range

    On Error GoTo Error_Handel

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .ShowWindowsInTaskbar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    For i = 1 To rngSource.Rows.Count
        For j = 1 To rngSource.Columns.Count

            If rngSource.Cells(i, j).Locked = False And _
               InStr(rngSource.Cells(i, j).Formula, "-") = 0 And _
               InStr(rngSource.Cells(i, j).Formula, "/") = 0 And _
               rngSource.Cells(i, j).HasFormula Then
                'Η Public μεταβλητή έχει δηλωθεί στο Module2. Εδώ αρχικοποιείται
                strF = rngSource.Cells(i, j).Formula
                rngSource.Cells(i, j).Formula = ReplaceMultiRecursion(rngSource.Cells(i, j).Formula)
            End If
        Next
    Next
    MsgBox "Ολοκληρώθηκε!"
Sub_Exit:

    With Application
        .Calculation = xlCalculationAutomatic
        .ShowWindowsInTaskbar = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub

Error_Handel:
    MsgBox "Πιθανόν δεν δόθηκε σωστά η περιοχή δεδομένων ", vbCritical + vbOKOnly, "Λάθος!"
    Resume Sub_Exit
End Sub

Φιλικά/Γιώργος