使用Excel VBA，如何將某壹個工作表保存到新建的Excel中?

代碼如下：

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

'刪除新建工作薄時默認新建的工作表

For Each Sh In Wk1.Worksheets

With Sh

If .Name Like "*Sheet*" Then

.Delete

End If

End With

For Each Sh In Wk2.Worksheets

With Sh

If .Name Like "*Sheet*" Then

.Delete

End If

End With

'保存部門和基層工作薄

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？