使用<em>Excel</em> <em>VBA</em>，如何将某一个

答：e799bee5baa6e997aee7ad94e58685e5aeb9366

Sub Demo()
    Dim Sht As Worksheet
    Dim FilePath As String
    FilePath = ThisWorkbook.Path & "\"
    Application.ScreenUpdating = False
    For Each Sht In ThisWorkbook.Sheets
        If Not Sht.Name = "分析" Then
            With Sht
                .UsedRange.Value = .UsedRange.Value
                .Copy
            End With
            With ActiveWorkbook
                .SaveAs Filename:=FilePath & Sht.Name
                .Close
            End With
        End If
    Next Sht
    Application.ScreenUpdating = True
    MsgBox "导出完成"
End Sub

1、如下图所示，我想将桌面上第一章中的每个工作簿名zhidao称放置到工作表中。

2、新建一个工作簿，将其命名为“第一章目录”，按alt+f11组合键，打开宏界面。

3、在VBA中，单击插入按钮，点击插入菜单下的模块，即可新建模块，系统默认为模块1，当然也可以根据需要重命名。

4、使用do~~loop循环语句，在VBA中输入如下图所示代码：

5、返回版名为“第一章目录”的工作簿中，按alt+f8组合键，弹出宏对话框。

6、点击宏对话框中的执行按钮，宏对话框自动关闭，代码自动执行，即第一章中的每个文件夹名称全部显示在工作表sheet1中。最后根据自己的需权要调整格式。

代码如下：
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时并没有把此表分别开，会不会出错？e79fa5e98193e4b893e5b19e336
以下是我自己的程序：
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’表的前面
是一个位置的问题

代码如下：
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 语句把过程中的无必要的警告都删除了，像在删除多余的工作表时会提示“数据可能在你要删除的工作表中，请问是否要删除”等等的警告，在写程序的过程中可以写不加人，有利于了解工程是怎么运作的，但是最后还是加上这两句比较好，否则e68a84e8a2ade799bee5baa6e997aee7ad94333用户使用时太多的警告信息感觉不是很好。
.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’表的前面
是一个位置的问题