如何复制所选工作薄中全部的工作表

yygpd500 · 发表于 2011-3-19 15:47

你的多次回复始终有答非所问之嫌，也罢，我给代码吧，不知这代码是否你真正想表达的意思：
Sub CopySht() '拷贝目标工作簿部全部工作表
Dim shtName As String '定义变量存放目标工作簿文件名（含路径的完整文件名或不含路径的文件名）
Dim sht As Object '定义对象变量指向目标工作簿的工作表
Dim shtCounts As Integer '定义变量存放当前工作簿已有工作表数量
Dim OldshtName As String '定义变量存放当前工作簿当前工作表名，以便拷贝完成后恢复选择当前工作表
'
OldshtName = ActiveSheet.Name '取得当前工作簿的当前工作表名
shtName = Application.GetOpenFilename '取得目标工作簿完整文件名
Workbooks.Open Filename:=shtName '打开目标工作簿
shtName = ActiveWorkbook.Name '取得当前工作簿（此时，打开的工作簿为当前工作簿）不含路径的文件名
For Each sht In ActiveWorkbook.Sheets '遍历当前工作簿所有工作表并逐一选中
sht.Select (False)
Next sht
With ThisWorkbook
ActiveWindow.SelectedSheets.Copy after:=.Sheets(.Sheets.Count) '把当前工作簿选中的工作表拷贝至本代码所在的工作簿，并放在最后
End With
Windows(shtName).Activate '重新激活上述打开的工作簿窗口
ActiveWorkbook.Sheets(1).Select '取消工作表成组选择状态
ActiveWindow.Close '关闭当前工作簿（即上述打开的的工作簿）
Set sht = Nothing '释放对象变量
Sheets(OldshtName).Select '恢复选择拷贝前所在的工作表
End Sub
另附上附件

[ 本帖最后由 yygpd500 于 2011-3-19 16:30 编辑 ]

snapstg · 发表于 2011-3-19 16:54

原帖由 yygpd500 于 2011-3-19 15:47 发表
你的多次回复始终有答非所问之嫌，也罢，我给代码吧，不知这代码是否你真正想表达的意思：
Sub CopySht() '拷贝目标工作簿部全部工作表
Dim shtName As String '定义变量存放目标工作簿文件名（含路径的完整文 ...

谢谢，就是这个意思啊，我表述真的那么差吗，

snapstg · 发表于 2011-3-20 01:00

原帖由 yygpd500 于 2011-3-19 15:47 发表
你的多次回复始终有答非所问之嫌，也罢，我给代码吧，不知这代码是否你真正想表达的意思：
Sub CopySht() '拷贝目标工作簿部全部工作表
Dim shtName As String '定义变量存放目标工作簿文件名（含路径的完整文 ...

为什么我们在打开选择文件的时候，点取消，会出错。

yygpd500 · 发表于 2011-3-20 11:21

原帖由 snapstg 于 2011-3-20 01:00 发表

为什么我们在打开选择文件的时候，点取消，会出错。

1.在“打开”对话框中，选择“取消”按钮，GetOpenFilename返回的是个逻辑值False，接下来的Workbooks.Open当然出错了，故此处应添加容错码。
2.同理，若接下来在执Workbooks.Open时产生错误，比如若打开的是一个带密码的工作簿文件且未能知晓密码而点选取消，将产生错误代码为1004的实时错误，所以要再次添加容错码。

添加容错码后的代码如下：

Sub CopySht() '拷贝目标工作簿部全部工作表
Dim shtName As String '定义变量存放目标工作簿文件名（含路径的完整文件名或不含路径的文件名）
Dim sht As Object '定义对象变量指向目标工作簿的工作表
Dim shtCounts As Integer '定义变量存放当前工作簿已有工作表数量
Dim OldShtName As String '定义变量存放当前工作簿当前工作表名，以便拷贝完成后恢复选择当前工作表
'
OldShtName = ActiveSheet.Name '取得当前工作簿的当前工作表名
shtName = Application.GetOpenFilename _
(filefilter:="工作簿文件（.xls）,*.xls", MultiSelect:=False) '取得目标工作簿完整文件名
If shtName = CStr(False) Then Exit Sub '若未选择工作簿，则退出
On Error Resume Next '若打开工作簿失败，则忽略错误
Workbooks.Open Filename:=shtName '打开目标工作簿
If Err.Number <> 0 Then '若打开工作簿失败，则退出
      On Error GoTo 0
      Exit Sub
End If
On Error GoTo 0
shtName = ActiveWorkbook.Name '取得当前工作簿（此时，打开的工作簿为当前工作簿）不含路径的文件名
For Each sht In ActiveWorkbook.Sheets '遍历当前工作簿所有工作表并逐一选中
   sht.Select (False)
Next sht
With ThisWorkbook
      ActiveWindow.SelectedSheets.Copy after:=.Sheets(.Sheets.Count) '把当前工作簿选中的工作表拷贝至本代码所在的工作簿，并放在最后
End With
Windows(shtName).Activate '重新激活上述打开的工作簿窗口
ActiveWorkbook.Sheets(1).Select '取消工作表成组选择状态
ActiveWindow.Close '关闭当前工作簿（即上述打开的的工作簿）
Set sht = Nothing '释放对象变量
Sheets(OldShtName).Select '恢复选择拷贝前所在的工作表
End Sub

snapstg · 发表于 2011-3-20 11:27

原帖由 yygpd500 于 2011-3-20 11:21 发表

1.在“打开”对话框中，选择“取消”按钮，GetOpenFilename返回的是个逻辑值False，接下来的Workbooks.Open当然出错了，故此处应添加容错码。
2.同理，若接下来在执Workbooks.Open时产生错误，比如若打开的是一个 ...

谢谢yygpd500老师，问题昨天晚上已经解决。

snapstg · 发表于 2011-3-20 15:08

原帖由 yygpd500 于 2011-3-20 11:21 发表

1.在“打开”对话框中，选择“取消”按钮，GetOpenFilename返回的是个逻辑值False，接下来的Workbooks.Open当然出错了，故此处应添加容错码。
2.同理，若接下来在执Workbooks.Open时产生错误，比如若打开的是一个 ...

再请教另外两个问题，麻烦您帮我看下：
1、在附件里面已经把问题讲清。

11.rar (64.66 KB, 下载次数: 4)

2、如果我要提取一个名叫“111“工作表里面某个单元格数据到控件TEXTBOX中，应该如何操作？
（111表可能不存在，如果不存在的话，提示“111工作表不存在”）

snapstg · 发表于 2011-3-20 17:16

原帖由 yygpd500 于 2011-3-20 11:21 发表

1.在“打开”对话框中，选择“取消”按钮，GetOpenFilename返回的是个逻辑值False，接下来的Workbooks.Open当然出错了，故此处应添加容错码。
2.同理，若接下来在执Workbooks.Open时产生错误，比如若打开的是一个 ...

YY老师，再请教下问题：
对于这个程序，导入数据后，如果删除导入进来的数据呢，我加入如下代码，虽然删除工作表后，但在工程中还有好几个像thisworkbook的东东未命名.jpg

，

Sub Delsh()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets

      If sh.Name <> "工作内容表" Then

         Application.DisplayAlerts = False

         sh.Delete


         Application.DisplayAlerts = True

      End If

Next
End Sub

yygpd500 · 发表于 2011-3-20 18:53

原帖由 snapstg 于 2011-3-20 15:08 发表

再请教另外两个问题，麻烦您帮我看下：
1、在附件里面已经把问题讲清。 891722

2、如果我要提取一个名叫“111“工作表里面某个单元格数据到控件TEXTBOX中，应该如何操作？
（111表可能不存在，如 ...

不知是否你想要的效果，供参考吧。另外，你的代码书写风格实在不敢恭维（竟然不缩进？！）。详情见附件。

yygpd500 · 发表于 2011-3-20 18:55

原帖由 snapstg 于 2011-3-20 17:16 发表

YY老师，再请教下问题：
对于这个程序，导入数据后，如果删除导入进来的数据呢，我加入如下代码，虽然删除工作表后，但在工程中还有好几个像thisworkbook的东东891788，

Sub Delsh()
Dim sh As Worksheet ...

初看，不大明白你说的什么。

snapstg · 发表于 2011-3-20 19:24

原帖由 yygpd500 于 2011-3-20 18:55 发表

初看，不大明白你说的什么。

我导入数据后，再删除，还有如图未命名.jpg

所示的SHEET11,SHEET12,SHEET13,SHEET14,我应如何才能删除他们。

		自动登录	找回密码
密码			免费注册

[已解决] 如何复制所选工作薄中全部的工作表