如何快速将多页数据集中到一页

Mendosa

如题，一共有两百多页，每页的数据行数不定（10-300），复制黏贴太慢了。。。。

效果见附件Summary页

看见星光

Book1 (2).zip (16.37 KB, 下载次数: 25)

2016-2-18 13:38 上传

点击文件名下载附件

1. Sub sss()
   
2. Dim sht As Worksheet, arr, brr, i&, j&, k&
   
3. ReDim brr(1 To 60000, 1 To 100)
   
4. For Each sht In Worksheets
   
5.     With sht
   
6.         If .Name <> ActiveSheet.Name Then
   
7.             arr = .[a1].CurrentRegion
   
8.             For i = 1 To UBound(arr)
   
9.                 k = k + 1
   
10.                 For j = 1 To UBound(arr, 2)
    
11.                     brr(k, j) = arr(i, j)
    
12.                 Next
    
13.             Next
    
14.         End If
    
15.     End With
    
16. Next
    
17. Cells.Clear
    
18. [a1].Resize(k, 100) = brr
    
19. End Sub
    

复制代码

icey5000

用宏，代码如下
Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")
If sp = "" Then
sp = 0
End If
st = InputBox("各表从第几行开始合并？不输则默认为2")
If st = "" Then
st = 2
End If
Sheets(1).Select
Sheets.Add

If st > 1 Then
Sheets(2).Select
Rows("1:" & CStr(st - 1)).Select
Selection.Copy
Sheets(1).Select
Range("A1").Select
ActiveSheet.Paste
y = st - 1
End If

For i = 2 To Sheets.Count
Sheets(i).Select
For v = 1 To 256
zd = Cells(65535, v).End(xlUp).Row
If zd > x Then
x = zd
End If
Next v
If y + x - st + 1 + sp > 65536 Then
MsgBox "内容太多，仅合并前" & i - 2 & "个表的内容，请把其它表复制到新工作薄里再用此程序合并！"
Else:

Rows(st & ":" & x).Select
Selection.Copy
Sheets(1).Select
Range("A" & CStr(y + 1)).Select
ActiveSheet.Paste

Sheets(i).Select
Range("A1").Select
Application.CutCopyMode = False
End If

y = y + x - st + 1 + sp
x = 0
Next i
Sheets(1).Select
Range("A1").Select
MsgBox "这就是合并后的表，请命名！"
End Sub

Mendosa

看见星光 发表于 2016-2-18 13:37

感谢，我套在其他表里，好像报错了

Mendosa

icey5000 发表于 2016-2-18 17:04
用宏，代码如下
Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")

感谢，这个好用，会出现的问题想得很周到
减少了很多工作量

冬冬冬冬日

icey5000 发表于 2016-2-18 17:04
用宏，代码如下
Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")

多写，特地注册过来评价，好强呀

LY123哦

icey5000 发表于 2016-2-18 17:04
用宏，代码如下
Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")

多谢多谢，用这个方便多了

327494259

大神讲的很仔细

1544085

icey5000 发表于 2016-2-18 17:04
用宏，代码如下
Sub 合并各工作表内容()
sp = InputBox("各表内容之间，间隔几行？不输则默认为0")

非常的好用。找了很久终于不经意的找到了。谢谢！