copy and sort sheetVBA Sort Macro

[tonywatsonhelp]

Hi Everyone,

I'm hoping some can help with this?

I have a document (Sheet "Data") I want to copy The sheet 4 times,
1st copy called "Aut1" and sorted by first row headers
Column J (Ascending)
Column D (Decending)
Column G Ascending)

2nd copy called "Aut2" and sorted by first row headers
Column R (Ascending)
Column D (Decending)
Column T Ascending)

3rd copy called "Aut3" and sorted by first row headers
ColumnH(Decending)
Column D (Decending)
Column G Ascending)

4th copy called "Aut4" and sorted by first row headers
Column J (Ascending)
Column G (Decending)
Column H Ascending)

I need the copies to be in order from left to right so Sheet "Data", "Aut1","Aut2" etc


please help if you can
Thanks
Tony

 

[HaHoBe]

Hi Tony,

please try

Public Sub MrE_1225294_1616414()
' https://www.mrexcel.com/board/threads/copy-and-sort-sheetvba-sort-macro.1225294/
' Created: 20221222
' By:      HaHoBe

Dim lngCounter As Long
Dim varSheets As Variant
Dim varCols As Variant
Dim varSCol As Variant
Dim varDir As Variant
Dim varSDir As Variant

For lngCounter = 4 To 1 Step -1
  Worksheets("Data").Copy after:=Worksheets("Data")
  ActiveSheet.Name = "Aut" & lngCounter
Next lngCounter

'using Arrays for Sheetnames, Columns and Direction for Sort
varSheets = Array("Aut1", "Aut2", "Aut3", "Aut4")
varCols = Array("J,D,G", "R,D,T", "H,D,G", "J,G,H")
varDir = Array("1,2,1", "1,2,1", "2,2,1", "1,2,1")    '1 = xlAscending, 2 = xlDescending

For lngCounter = LBound(varSheets) To UBound(varSheets)
  varSCol = Split(varCols(lngCounter), ",")
  varSDir = Split(varDir(lngCounter), ",")
  With Sheets(varSheets(lngCounter)).Sort
    With .SortFields
      .Clear
      .Add2 Key:=Sheets(varSheets(lngCounter)).Cells(1, varSCol(0)), SortOn:=xlSortOnValues, _
          Order:=CLng(varSDir(0)), DataOption:=xlSortNormal
      .Add2 Key:=Sheets(varSheets(lngCounter)).Cells(1, varSCol(1)), SortOn:=xlSortOnValues, _
          Order:=CLng(varSDir(1)), DataOption:=xlSortNormal
      .Add2 Key:=Sheets(varSheets(lngCounter)).Cells(1, varSCol(2)), SortOn:=xlSortOnValues, _
          Order:=CLng(varSDir(2)), DataOption:=xlSortNormal
    End With
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
Next lngCounter

End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Tony,

while trying to put everything into a single loop I found out that the code supplied did not accept the sorting for the single sheets. I altered the sort routine and checked the results after the procedure ran, at least in my sample workbook the proper columns were sorted on each added sheet (assuming that headers are in Row 1 on Sheet Data):

Public Sub MrE_1225294_1616414_Update01()
' https://www.mrexcel.com/board/threads/copy-and-sort-sheetvba-sort-macro.1225294/
' Created: 20221222
' By:      HaHoBe
' Updated: 20221222
' Reason:  changed to only use 1 loop and altered the sort routine

Dim lngCounter      As Long
Dim lngLast         As Long
Dim varCols         As Variant
Dim varSCol         As Variant
Dim varDir          As Variant
Dim varSDir         As Variant

'using Arrays for Columns and Direction for Sort
varCols = Array("J,D,G", "R,D,T", "H,D,G", "J,G,H")
varDir = Array("1,2,1", "1,2,1", "2,2,1", "1,2,1")    '1 = xlAscending, 2 = xlDescending

For lngCounter = 4 To 1 Step -1
  Worksheets("Data").Copy after:=Worksheets("Data")
  ActiveSheet.Name = "Aut" & lngCounter
  varSCol = Split(varCols(lngCounter - 1), ",")
  varSDir = Split(varDir(lngCounter - 1), ",")
  With ActiveSheet
    lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Sort.SortFields.Clear
    .Range(.Cells(1, "A"), .Cells(lngLast, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Sort _
                                  Key1:=ActiveSheet.Cells(1, varSCol(0)), _
                                  Key2:=ActiveSheet.Cells(1, varSCol(1)), _
                                  Key3:=ActiveSheet.Cells(1, varSCol(2)), _
                                  Header:=xlYes, _
                                  Order1:=varSDir(0), _
                                  Order2:=varSDir(1), _
                                  Order2:=varSDir(2)
    .Sort.SortFields.Clear
  End With
Next lngCounter

End Sub

Holger

 

[tonywatsonhelp]

Hi Holger,
Thank you, this seems to work great,
Big thanks
Tony