Here's what I would have posted last night;with the addition of a new sheet:
Sub SORTIN()
ActiveSheet.UsedRange.Copy
Worksheets.Add
ActiveSheet.Paste
Dim LstCo As Long, LstRow As Long, c As Long, r As Long, LC As Range
Application.ScreenUpdating = False
LstCo = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
LstRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).row
Set LC = Cells(LstRow + 1, LstCo + 1)
For r = 1 To LstRow
Range(Cells(r, 1), Cells(r, LstCo)).sort _
Key1:=Cells(r, 1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=True, Orientation:=xlLeftToRight, _
DataOption1:=xlSortTextAsNumbers
SwitchCells:
For c = 1 To LstCo Step 2
If Cells(r, c) <> Cells(r, c + 1) Then
LC = Cells(r, c): Cells(r, c) = Cells(r, c + 1)
Cells(r, c + 1) = LC: LC = "": End If: Next c: Next r
Application.ScreenUpdating = True
End Sub
Bookmarks