Hi All...
The famous VoG made this a long time ago......
I would like to expand this to sort more column-columns (user defined) after the initial breakout of sheets...
I DONT want it to create new sheets just sort one or more columns within...
EX:
This script will break the master sheet by Column "H"......I would also like it to sort columns E & P within that initial breakout...
Thxs
The famous VoG made this a long time ago......
I would like to expand this to sort more column-columns (user defined) after the initial breakout of sheets...
I DONT want it to create new sheets just sort one or more columns within...
EX:
This script will break the master sheet by Column "H"......I would also like it to sort columns E & P within that initial breakout...
Thxs
Code:
Sub Lapta()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("H2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Range("H" & i).Value <> .Range("H" & i + 1).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Range("H" & iStart).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub