|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 zhouxiao 于 2012-8-21 11:19 编辑
试试
Sub 复制到新建()
Dim Erow%, Dsrow%, Derow%, Sh, Shexist As Boolean, 区域
Sheets("总表").Select
Erow = [a65536].End(xlUp).Row
Range("a2:l" & Erow).Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
With Sheets("总表")
For Each 区域 In .Range("F2:F" & Erow)
If 区域 <> 区域.Offset(-1, 0) Then
Dsrow = Application.Match(区域, .Range("F1:F" & Erow), 0)
Derow = Application.Match(区域, .Range("F1:F" & Erow), 1)
Shexist = False
For Each Sh In ThisWorkbook.Sheets
If Sh.Name = 区域 Then
Sh.Select
Shexist = True
Exit For
End If
Next
If Shexist = False Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = 区域
End If
ActiveSheet.Cells.ClearContents
.Rows("1:1").Copy ActiveSheet.Rows("1")
.Rows(Dsrow & ":" & Derow).Copy ActiveSheet.Rows("2")
End If
Next
End With
End Sub
这是我在一个老师的代码上改动的.
|
|