[已解决]求助合并工作表并排序的宏语言

lyj0910

RT
自己整理的宏总觉得很累赘，请教怎么精简

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-12-20 15:41

稍作修改：
汇总表.rar (14.79 KB, 下载次数: 21)

2013-12-20 15:53 上传

点击文件名下载附件

1. Sub 汇总()
   
2. Range("A2:z5000").ClearContents
   
3. Dim m As Integer
   
4. Dim n As Integer
   
5. Dim o As Integer, i As Long
   
6. For m = 2 To 7
   
7.    n = Sheets(m).[a65536].End(xlUp).Row
   
8.    o = Sheets(1).[a65536].End(xlUp).Row
   
9.    Sheets(m).Range("a2", "z" & n).Copy
   
10.    Sheets(1).Paste Sheets(1).Range("a" & o + 1)
    
11. Next m
    
12.     o = Sheets(1).[a65536].End(xlUp).Row
    
13.     Application.CutCopyMode = False
    
14.     Sheets("汇总").Range("a2:g" & o).Sort Key1:=Range("A1"), Order1:=xlAscending
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

木槿在流浪

{:08:}

yyyydddd8888

稍作修改：
汇总表.rar (14.79 KB, 下载次数: 21)

2013-12-20 15:53 上传

点击文件名下载附件

1. Sub 汇总()
   
2. Range("A2:z5000").ClearContents
   
3. Dim m As Integer
   
4. Dim n As Integer
   
5. Dim o As Integer, i As Long
   
6. For m = 2 To 7
   
7.    n = Sheets(m).[a65536].End(xlUp).Row
   
8.    o = Sheets(1).[a65536].End(xlUp).Row
   
9.    Sheets(m).Range("a2", "z" & n).Copy
   
10.    Sheets(1).Paste Sheets(1).Range("a" & o + 1)
    
11. Next m
    
12.     o = Sheets(1).[a65536].End(xlUp).Row
    
13.     Application.CutCopyMode = False
    
14.     Sheets("汇总").Range("a2:g" & o).Sort Key1:=Range("A1"), Order1:=xlAscending
    
15. End Sub
    

复制代码

xdragon

1. Sub 汇总()
   
2.    Dim sh As Worksheet
   
3.    Dim arr, brr(), i&, j%, c&
   
4.    For Each sh In Worksheets
   
5.      If sh.Name Like "表*" Then
   
6.        j = sh.Cells(Rows.Count, 1).End(3).Row
   
7.        arr = sh.Range("A2:E" & j).Value
   
8.        For i = 1 To UBound(arr)
   
9.          c = c + 1
   
10.          ReDim Preserve brr(1 To 5, 1 To c)
    
11.          For j = 1 To UBound(arr, 2)
    
12.            brr(j, c) = arr(i, j)
    
13.          Next
    
14.        Next
    
15.      End If
    
16.    Next
    
17.    With Sheets("汇总")
    
18.      .Range("A2").Resize(c, 5) = Application.Transpose(brr)
    
19.      .Sort.SortFields.Clear
    
20.      .Sort.SortFields.Add Key:=.Range("A2").Resize(c, 5), _
    
21.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
22.    End With
    
23. End Sub

复制代码

晕，刚刚回错帖子了。。。