vba 拷贝工作表、保存工作表

EXCEL VBA 保存工作表到新的工作簿中  

2011-07-18 10:31:48|  分类： VB/VB.NET |  标签： |举报 |字号大中小 订阅

    在工作中遇到保存工作表保存到新的工作簿中，即把sheet拷贝到一个新的xls里，从网上查了一个例子比较适合，是把“部门”跟“基层”的工作表重新保存在指定位置中。

代码如下：
Sub 分开存为工作薄()

Dim Sh As Worksheet
Dim Wk1 As Workbook
Dim Wk2 As Workbook
Dim iPath As String

Application.ScreenUpdating = False   ‘将屏幕更新关闭
Application.DisplayAlerts = False

iPath = ThisWorkbook.Path & "\"     '保存路径为当前工作簿所在路径
Set Wk1 = Workbooks.Add
Set Wk2 = Workbooks.Add
Wk1.SaveAs iPath & "部门" & ".xls"
Wk2.SaveAs iPath & "基层" & ".xls"
'将工作表分别复制到部门或基层工作薄中
For Each Sh In ThisWorkbook.Worksheets
   With Sh
     If .Name Like "*部门*" Then
        .Copy before:=Workbooks("部门").Worksheets("sheet1")
     ElseIf .Name Like "*基层*" Then
        .Copy before:=Workbooks("基层").Worksheets("sheet1")
     Else
         MsgBox "工作表" & .Name & "不含有部门或基层"
     End If
    End With
Next
  '删除新建工作薄时默认新建的工作表
For Each Sh In Wk1.Worksheets
   With Sh
     If .Name Like "*Sheet*" Then
        .Delete
     End If
    End With
Next
For Each Sh In Wk2.Worksheets
   With Sh
     If .Name Like "*Sheet*" Then
        .Delete
     End If
    End With
Next
'保存部门和基层工作薄
Wk1.Save
Wk2.Save
Wk1.Close
Wk2.Close
Set Wk1 = Nothing
Set Wk2 = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

其中Application.DisplayAlerts、 Application.ScreenUpdating 语句把过程中的无必要的警告都删除了，像在删除多余的工作表时会提示“数据可能在你要删除的工作表中，请问是否要删除”等等的警告，在写程序的过程中可以写不加人，有利于了解工程是怎么运作的，但是最后还是加上这两句比较好，否则用户使用时太多的警告信息感觉不是很好。

.Copy before:=Workbooks("基层").Worksheets("sheet1")

此句是拷贝sheet到新的xls里，由于使用了with语句，前面的workbook的信息省略了，但是有copy before与copy after注意选择，具体区别自己也不是很清楚。Workbooks("基层").Worksheets("sheet1")拷贝到基层.xls的sheet1里，但是看到下面删除sheet时并没有把此表分别开，会不会出错？

以下是我自己的程序：

Set sht = newbk.Worksheets(1)     '删除新建的newbk里的两个sheet，必须留一个，否则会出错
sht.Delete
Set sht = newbk.Worksheets(1)
sht.Delete
oldbk.Worksheets(sSheetName).Copy After:=newbk.Worksheets(1)   '拷贝

Set sht = newbk.Worksheets(1)            ’删除一个工作表，会删错么？
sht.Delete

newbk.Worksheets(1).Name = sSheetName
newbk.Save

拷贝处选用的是Worksheets(1)，本想用Worksheets(sSheetName)，但是系统出错，应该是新xls中没有此sheet，只有默认的1、2、3，所以出错。

对删除工作表的操作表示疑问，因为怕删错，Worksheets(1）是选择当前最前端的窗口，此程序测试正确，那么应该是新生成的没有作为active？

===============================================

所以拷贝时有3个问题：

1、copy before 与copy after的区别？

2、copy后新的名称是什么？

3、copy后的表是不是最前端的？

 

从网上看到的，可以对第一个问题很好的解释：

Sheets("mainREPORT").Copy Before:=Sheets(4)

after：是將表mainreport創建拷貝到‘4’表的后面

before：是將表mainreport創建拷貝到‘4’表的前面

是一個位置的問題

vba工作表命名并保存到新工作簿

小妹有VBA问题，保存工作簿中的一个特定工作表，根据工作簿当中的另一个工作表中的单元格命名这个工作表并保存为新工作簿 ，这个工作表的名字不变，只是保存这个新命名的工作簿。保存时有选择保存路径。求VBA代码。谢谢哥哥姐姐各位大侠了。

满意答案

Sub test()
Dim SaveDir, newName As String
newName = Sheets("Sheet2").Range("B2")   '所谓的另一个工作表的单元格，自己改工作表名称和单元格以获得新工作簿的名称
SaveDir = Application.GetOpenFilename
SaveDir = Left(SaveDir, InStrRev(SaveDir, "\"))
Sheets("Sheet1").Copy    '所谓特定工作表，自己改名称
ActiveWorkbook.SaveAs SaveDir & newName
End Sub


运行此宏，会弹出一让你选择文件路径及文件，你得手动点到待保存路径，并必须选择该路径下的一文件（这样才能获取文件路径）。如果你路径已知，建议你直接修改代码
SaveDir = Application.GetOpenFilename
SaveDir = Left(SaveDir, InStrRev(SaveDir, "\"))
为
SaveDir = "D:\abc\"