Dim CurrentRow
Dim dati(1 To 200) As String
Dim numElem As Integer

Sub Anagramma(x As String, y As String)
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
  If esiste(x & y) Then inserisci (x & y)
Else
  For i = 1 To j
    Call Anagramma(x + Mid(y, i, 1), _
    Left(y, i - 1) + Right(y, j - i))
  Next
End If
End Sub

Public Function esiste(parola As String) As Boolean
Dim L As String
L = Str(Len(parola))
With Sheets(L).Range("A:A")
    Set c = .Find(parola, LookIn:=xlValues)
    If Not c Is Nothing Then
      esiste = True
    Else
      esiste = False
    End If
End With
End Function

Public Sub inserisci(valore)
Dim blnTrovato As Boolean
Dim i As Integer
blnTrovato = False
For i = 1 To numElem
  If UCase(dati(i)) = UCase(valore) Then
    blnTrovato = True
    Exit For
  End If
Next
If blnTrovato = False Then
  If Not IsEmpty(valore) Then
    numElem = numElem + 1
    dati(numElem) = valore
    UserForm1.ListBox1.AddItem (valore)
  End If
End If
End Sub