Dario,

The following ought to be close to what you want
and it certainly is simpler. Does it do what you wanted?

'--------------------------------
Sub ReverseDirectory_New()
Application.ScreenUpdating = False
Columns("D:E").Insert shift:=xlShiftToRight
Columns("D:E").Value = Columns("A:B").Value
Columns("A").Value = Columns("E").Value
Columns("B").Value = Columns("D").Value
Application.ScreenUpdating = True
End Sub
'--------------------------------------

Regards,
Jim Cone
San Francisco, USA


"Dario de Judicibus" wrote in
message ...
I would like some help to improve the following macro (I am NOT an Excel
programmer). The macro simply invert a sheet where column 1 is for terms and
columns 2-n are for translations. I would like
1. to move the temporary range to another sheet, to avoid overlap between
temporary range and current one
2. improve performances
Any hints appreciated. Thank you in advance.
--
Dario de Judicibus - Rome, Italy (EU)
Site: http://www.dejudicibus.it
Blog: http://lindipendente.splinder.com

MACRO
Public Sub ReverseDictionary()
Set tr = ActiveSheet.UsedRange
Debug.Print tr.Rows.Count
Debug.Print tr.Columns.Count
Set newlist = Cells(1, tr.Columns.Count + 2) 'Temporary range
newrow = 0
For n = 1 To tr.Rows.Count
head = tr.Cells(n, 1)
c = 2
While Not IsEmpty(tr.Cells(n, c))
newrow = newrow + 1
newlist.Cells(newrow, 1).NumberFormat = "@"
newlist.Cells(newrow, 2).NumberFormat = "@"
newlist.Cells(newrow, 1) = head
newlist.Cells(newrow, 2) = tr.Cells(n, c)
c = c + 1
Wend
Next
Range(newlist, newlist.Cells(newrow, 2)).Sort Key1:=newlist.Cells(1, 2),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
tr.Clear
outrow = 0
head = ""
For n = 1 To newrow
If head = newlist(n, 2) Then
outcol = outcol + 1
tr.Cells(outrow, 1).NumberFormat = "@"
tr.Cells(outrow, outcol).NumberFormat = "@"
tr.Cells(outrow, 1) = head
tr.Cells(outrow, outcol) = newlist(n, 1)
Else
outcol = 1
outrow = outrow + 1
head = newlist(n, 2)
n = n - 1
End If
Next
Range(newlist, newlist.Cells(newrow, 2)).Clear
End Sub