|
下面的是别人给我的宏工具代码,我想实现拆分表格时把sheet1名称变更为LTE,还想同时实现2个sheet同时拆分成1个excel表。另一个名称变更为汇总,里面的sheet名称不变,可以实现吗?大哥们!!!!!!!!!!
Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Dim lk(1 To 35), hg(1 To 5)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:a" & r)
For j = 1 To 35
lk(j) = .Columns(j).ColumnWidth
Next
For i = 1 To 2
hg(i) = .Rows(i).RowHeight
Next
For i = 2 To UBound(arr)
xm = arr(i, 1)
If Not d.exists(xm) Then
Set d(xm) = .Range("a1:ai1")
End If
Set d(xm) = Union(d(xm), .Cells(i, 1).Resize(1, 35))
Next
End With
Application.SheetsInNewWorkbook = 1
For Each aa In d.keys
Set wb = Workbooks.Add
With wb
With .Worksheets(1)
d(aa).Copy .Range("a1")
For j = 1 To 35
.Columns(j).ColumnWidth = lk(j)
Next
For i = 1 To 2
.Rows(i).RowHeight = hg(i)
Next
r = .Cells(.Rows.Count, 1).End(xlUp).Row
.Rows("5" & r).RowHeight = hg(2)
End With
.SaveAs Filename:=ThisWorkbook.Path & "\" & aa
.Close False
End With
Next
End Sub
|
|