excel工作表汇总模块

  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。

//*
此宏用于合并同一工作簿内的所有工作表!
打开你的工作簿,按下alt+F11,插入-模块,看见一个模块1,复制下面的的内容,然后运行。
你的 工具-宏-安全性,设置为中,才能运行此宏。
按照提示做就可以了。注意:如果工作表很多可能需要很长时间,请耐心等待!
*//
==========以下是宏===============



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

相关文档
最新文档