Sort multiple columns on sheet into A-Z

[surkdidat]

Hi

I have headers in Row 1, and pairs of data in columns (A&B, C&D, E&F all the way to FSS&FST). (Data from Row 4 to Row 1000 - not all rows will go down to row 1000, some will only ave one match, some will have 100, some could have 500 etc)

The data starts in row 4.

What I need it to do is sort the columns in alphabetical order, retaining the pair value for all 2285 pairs.

PRESENT DATA

	Column A	Column B	Column C	Column D
Row 1	COLOUR-ENG	COLOUR-FR	SHAPE-ENG	SHAPE-FR
Row 2	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)
Row 3	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)
Row 4 (Beginning of data)	Blue	Bleu	Round	Arrondi
Row 5	Yellow	Jaune	Square	Carré
Row 6	Red	Rouge	Arch	Arc
Row 7	Green	Vert	Pyramid	Pyramide

RESULT

	Column A	Column B	Column C	Column D
Row 1	COLOUR-ENG	COLOUR-FR	SHAPE-ENG	SHAPE-FR
Row 2	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)
Row 3	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)	(DATA HELD HERE - NOT TO BE MOVED)
Row 4	Blue	Bleu	Arch	Arc
Row 5	Green	Vert	Pyramid	Pyramide
Row 6	Red	Rouge	Round	Arrondi
Row 7	Yellow	Jaune	Square	Carré

 

[shknbk2]

Try this:

Sub SortData()
    Dim col As Long
    Dim dataRange As Range
    Dim sortRange As Range
    
    Set dataRange = Range("A1").CurrentRegion
    For col = 1 To dataRange.Columns.Count Step 2
        Set sortRange = Range(Cells(4, col), Cells(Rows.Count, col).End(xlUp))
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add2 Key:=sortRange, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange sortRange.Resize(sortRange.Rows.Count, 2)
            .Header = False
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Next
End Sub

 

[surkdidat]

Lovely - superbly helpful code!