请教并请修改将指定的工作薄中的所以工作表或部分工作表复制到当前工作薄后面的宏代码

清风明月12

                  请教并请修改将指定的工作薄中的所以工作表或部分工作表复制到当前工作薄后面的宏代码

      这是我根据别人的代码改造后的一个宏，但它有一个严重弱点，就是工作表只能复制到宏所在的工作薄中。我希望是将工作表复制到我启动宏时所在的工作薄中，这样应用范围就广得多了。
还有能不能只复制“校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板.xls”工作薄中的某三个指定名称的工作表到当前激活工作薄的后面。
请众位老师指教！

Sub 导入校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板文件中的工作表()
Dim oWb As Workbook
Dim oSh As Worksheet
Set oWb = Workbooks.Open("D:\DXM金山快盘文件夹\01-金山快盘新浪jiangxidengximu文件夹\常用的最简单基本程序(多由综合性程序分解而来)\校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板.xls")
Application.ScreenUpdating = False
For Each oSh In oWb.Worksheets
   oSh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
oWb.Close False
Application.ScreenUpdating = True
End Sub

adders

基本上有两种方法,取决于各人喜好,一是建立personal.xls,二是通过add-in(中文好象是加载宏吧),各有优缺点,如果主要是你自己用,建议用personal.xls,如果主要是公司多人(或客户)多台电脑用,那么加载宏较好.

假定你这个宏主要是自己用,第一种方法的步骤如下:
1) 新建一个文件,名称自定,比如我用的就叫:personal.xls
2) 将以上代码编入personal.xls中
3) 将personal.xls放入一个单独的文件夹中,建议新建一个目录,如C:\Personal\之类的,注意这个文件夹内只放这一个文件
4) 在Excel菜单栏上,选择Tool --> Option --> 找到General这个tab, 然后在At start up, open all files in:这一栏框内,输入以上目录,如C:\Personal\
5) 重启Excel,这样无论你打开任何Excel文件时,personal.xls这个文件都会自动打开并隐藏
6) 再去Tool --> Customize, 选中间的Command这个tab,在左边的表中找到Macro,然后在右边会出现相应的两个图标,你可以任意选择一个,比如选择笑脸符号吧,用鼠标拖曳到工具栏上,紧接着右键点这个笑脸,在下拉菜单中,选择Assign Macro,然后把personal.xls里的VBA程序assign给这个笑脸符号.
7) 以后你每次打开任何Excel文件,点击笑脸就会直接运行你的程序在当前打开的文件中.

希望上面的步骤能够帮到您

清风明月12

没有看到宏代码啊

adders

清风明月12 发表于 2011-12-23 22:21
没有看到宏代码啊

就是你自己的宏代码啊,你不是在主贴里写出来了吗? 就是把你这个代码写进新建的personal.xls文件里

Sub 导入校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板文件中的工作表()
Dim oWb As Workbook
Dim oSh As Worksheet
Set oWb = Workbooks.Open("D:\DXM金山快盘文件夹\01-金山快盘新浪jiangxidengximu文件夹\常用的最简单基本程序(多由综合性程序分解而来)\校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板.xls")
Application.ScreenUpdating = False
For Each oSh In oWb.Worksheets
   oSh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
oWb.Close False
Application.ScreenUpdating = True
End Sub

清风明月12

不行啊，我假设当前在工作薄A中，运行这个宏，它可不是将 工作表复制到A中，而是复制到宏代码所在的工作薄“personal.xls”。问题就出在这里啊

adders

清风明月12 发表于 2011-12-23 23:08
不行啊，我假设当前在工作薄A中，运行这个宏，它可不是将 工作表复制到A中，而是复制到宏代码所在的工作薄“ ...

把放在personal.xls这个文件中的代码稍作修改如下:

Sub 导入校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板文件中的工作表()
Dim mywb As Workbook
Set mywb = ActiveWorkbook

Dim oWb As Workbook
Dim oSh As Worksheet
Set oWb = Workbooks.Open("D:\DXM金山快盘文件夹\01-金山快盘新浪jiangxidengximu文件夹\常用的最简单基本程序(多由综合性程序分解而来)\校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板.xls")
Application.ScreenUpdating = False
For Each oSh In oWb.Worksheets
   oSh.Copy After:=mywb.Sheets(mywb.Sheets.Count)
Next
oWb.Close False

Set mywb = Nothing
Set oWb = Nothing
Application.ScreenUpdating = True
End Sub

清风明月12

谢谢6楼老师的帮助，这个宏代码试运行后，符合要求，解决了问题。我还据你的代码做出另一套代码，就是只复制这个工作薄的某几个指定工作表，愿能给菜鸟级的坛友有帮助。
各位坛友，圣诞快乐！

Sub 导入校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板文件中的某些工作表()
Dim mywb As Workbook
Set mywb = ActiveWorkbook

Dim oWb As Workbook
Dim oSh As Worksheet
Set oWb = Workbooks.Open("D:\DXM金山快盘文件夹\01-金山快盘新浪jiangxidengximu文件夹\常用的最简单基本程序(多由综合性程序分解而来)\校对东莞市中材试验室土样成果同时将土样成果分解为输入理正的信息的模板.xls")
Application.ScreenUpdating = False
Sheets(Array("东莞市中材试验室土样单为输入理正分解", "分解土样第二阶段", "抗压强度(三)及密度20统计表")).Copy Before:=mywb.Sheets(mywb.Sheets.Count)

oWb.Close False

Set mywb = Nothing
Set oWb = Nothing
Application.ScreenUpdating = True
End Sub

清风明月12

当下网络情况无法设置6楼为最佳答案，情况好后再设