|
Public Sub dd()
Dim workrange As Range
Dim name1 As String
Dim rge As Range
Dim wb As Workbook
Set workrange = Intersect(Range("a1").CurrentRegion.Offset(1, 0), Range("a1").CurrentRegion)
ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Intersect(workrange, Columns(1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Intersect(workrange, Columns(2)) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("a1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
' .SortMethod = xlPinYin
.Apply
End With
For Each rge In Intersect(workrange, Columns(1))
If rge <> rge.Offset(-1, 0) Then
ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.AutoFilter Field:=1, Criteria1:=rge.Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.Copy Worksheets("Sheet1").Range("a1")
wb.SaveAs ThisWorkbook.Path & "\" & rge.Value & ".xlsx"
End If
Next
End Sub
|
|