有一段批量保存一个工作薄内的工作表到当前文件夹的EXCEL VBA代码，现在我想修改一下代码，实现两个功能

Question

1、不保存第一个工作表名为“目录”的表；2、其它各个工作表保存时，新建以各个工作表中的相同单元格(例如D4)为文件夹名，将相同的工作表保存到该文件夹下。由于涉及的工作表很多，工作表也有规律，所以请大侠们帮忙看看。先拜谢了，分不多，请海涵。代码如下：
Sub 另存所有工作表为工作簿()
Dim sht As Worksheet
Application.ScreenUpdating = False '禁用屏幕刷新
ipath = ThisWorkbook.Path & "\" '默认保存在当前文件夹
For Each sht In Sheets
sht.Copy
ActiveWorkbook.SaveAs ipath & sht.Name & ".xls", FileFormat:=xlExcel8
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub
补充1下：
不会有很多文件夹的，顶多20多个。例如以类别名作为文件夹，很多工作表的名属于这个类别，即这个类别下有多个小类属于它，其他类一样的道理。小类就是各个工作表名，所有除了“目录”工作表以外的工作表固定的单元格都有大类的名，即文件夹的名。

不知道这样是否表述清楚了？谢谢各位热心的网友哦

Answer 1

Sub 另存所有工作表为工作簿()
Dim sht As Worksheet
Application.ScreenUpdating = False '禁用屏幕刷新
ipath = ThisWorkbook.Path & "\" '默认保存在当前文件夹
For Each sht In Sheets
If sht.Name <> "目录" Then
If sht.Range("D4") <> "" Then
myipath = ipath & sht.Range("D4")
Else
myipath = ipath & "新建文件夹"
End If
If Dir(myipath, vbDirectory) <> "" Then
MsgBox ipath & "目录存在,文件将保存在该目录!"
Else
MkDir myipath
End If
sht.Copy
ActiveWorkbook.SaveAs myipath & "\" & sht.Name & ".xls"
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub追问

非常感谢哦，代码很完美，可是总是弹出对话框，能不能不要让它提示，直接确定覆盖就好了呢？这个MsgBox我不会，去掉以后会出错……谢谢哦

Answer 2

所有A4相同的都保存在一个文件夹内？那不是要新建好多文件夹了？

Answer 3

不懂