excel工作表拆分&合并代码

上传人:小** 文档编号:91143847 上传时间:2019-06-26 格式:DOC 页数:4 大小:19.82KB
返回 下载 相关 举报
excel工作表拆分&合并代码_第1页
第1页 / 共4页
excel工作表拆分&合并代码_第2页
第2页 / 共4页
excel工作表拆分&合并代码_第3页
第3页 / 共4页
excel工作表拆分&合并代码_第4页
第4页 / 共4页
亲,该文档总共4页,全部预览完了,如果喜欢就下载吧!
资源描述

《excel工作表拆分&合并代码》由会员分享,可在线阅读,更多相关《excel工作表拆分&合并代码(4页珍藏版)》请在金锄头文库上搜索。

1、工作表汇总1、多个工作簿汇总成一个将这些文件放到一个文件夹,确保只有这些文件,且若打开某一文件,数据就能看见即不用点其他sheet。建一新Excel,也存到该文件夹。仅打开该新Excel,同时按Alt和F11进入宏界面,点菜单的插入,模块,粘贴如下代码:Sub Find()Application.ScreenUpdating = FalseDim MyDir As StringMyDir = ThisWorkbook.Path & ChDrive Left(MyDir, 1) find all the excel filesChDir MyDirMatch = Dir$()DoIf Not L

2、Case(Match) = LCase(ThisWorkbook.Name) ThenWorkbooks.Open Match, 0 openActiveSheet.Copy Before:=ThisWorkbook.Sheets(1) copy sheetWindows(Match).ActivateActiveWindow.CloseEnd IfMatch = Dir$Loop Until Len(Match) = 0Application.ScreenUpdating = TrueEnd Sub在此界面直接按F5键运行此宏,完成2、多个工作表汇总成一个Sub 合并工作表()For i =

3、 2 To Sheets.CountSheets(i).UsedRange.Copy Destination:=Sheets(汇总).Range(A & Sheets(汇总).UsedRange.Rows.Count + 1)NextEnd SubALT+F11,打开代码窗口.粘贴代码回到工作表中.按ALT+F8,运行这段代码就可以了保证第一个工作表名称为 汇总合并后如果有多余的标题行,自己筛选来删除就OK了工作表拆分Sub 工作薄拆分() 将工作薄按工作表拆分成多个工作薄 Dim PATH As String PATH = Application.ActiveWorkbook.PATH Di

4、m sht As Worksheet Application.ScreenUpdating = FalseFor Each sht In Sheets sht.copyActiveWorkbook.SaveAs PATH & & sht.NAME & .xls (工作表名称为文件名) ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub Sub UnhideAllSheets() For Each Sheet In ActiveWorkbook.SheetsSheet.Visible = True Next En

5、d sub求助工作表名称等于单元格B2内容Private Sub 引用单元格数据命名工作表()On Error Resume Next ignoreDim i%, Sht As WorksheetFor Each Sht In SheetsIf Sht.Name 工程汇总表 ThenSht.Name = Sht.Cells(2, 2).ValueEnd IfNextEnd Sub求助请问老师 工作表的标签名 能否随单元格的内容变化Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range(A1) Then Activ

6、eSheet.Name = Range(A1)End Sub如果 工作表标签的名 和 A1 的值 相同时 就退出要执行的程序程序Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range(A1) And Range(A1) ActiveSheet.Name ThenActiveSheet.Name = Range(A1)Elsea1 = u1.ValueEnd IfEnd SubSub 插入行并复制上行()ActiveCell.Offset(-1, 0).Rows(1:1).EntireRow.SelectSelection.CopySelection.Insert Shift:=xlDownActiveCell.Offset(1, 0).Range(A1).SelectApplication.CutCopyMode = FalseEnd Sub

展开阅读全文
相关资源
正为您匹配相似的精品文档
相关搜索

最新文档


当前位置:首页 > 商业/管理/HR > 管理学资料

电脑版 |金锄头文库版权所有
经营许可证:蜀ICP备13022795号 | 川公网安备 51140202000112号