[kapetang]

Καλησπέρα

Δημήτρη είδα καλύτερα τον κώδικα που πρόσθεσες.

Αν κατάλαβα καλά θέλεις μια περιοχή να αντιγράφεται σε μια άλλη ως εξής:

Αν ένα κελί είναι προστατευμένο ή έχει τύπο που περιέχει το «-» ή το «/» αντιγράφεται όπως είναι, διαφορετικά καλείται η συνάρτηση για να κάνει την κατάλληλη αλλαγή.

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

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

    On Error GoTo Error_Handel

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)
    Set rngTarget = 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
                rngTarget.Cells(i, j).Formula = ReplaceMultiRecursion(rngSource.Cells(i, j).Formula)
            Else
                rngTarget.Cells(i, j) = rngSource.Cells(i, j)
            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

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