Question

excel vba另存为去掉其中一个工作簿

excel vba另存为去掉其中一个工作簿，电子表格中有多个工作簿，用vba另存为的时候想要去掉最后一个(去掉sheet1，或者复制其它的工作簿到另一个新的文件)。
没法上传文件，我把vba的代码贴上来吧。
Sub Macro1()
'
' Macro1 Macro
'
s = Range("c7") & " " & Range("b6")
ActiveWorkbook.SaveAs Filename:="D:\My Documents\信用村评定\" & s & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Sub 另存()
For i = 70 To 367 '需要另存为的序号
Range("c7").Value = i
Call Macro1
Next
End Sub
http://www.baidupcs.com/file/83ea441cc2319421ebd87669926b0d66?xcode=eff3b76b385bb464861fd934cfd037f3992086961e8b1ae4&fid=3439473609-250528-2413031081&time=1383609351&sign=FDTAXER-DCb740ccc5511e5e8fedcff06b081203-I%2FhOcUF7JzinhJsEfwO3CFMfXpw%3D&to=wb&fm=B,B,T,t&expires=8h&rt=pr&r=222889575&logid=4049115375&fn=%E5%86%9C%E6%88%B7%E4%BF%A1%E6%81%AF%E9%87%87%E9%9B%86%E5%AF%BC%E5%85%A5%E6%A8%A1%E6%9D%BF.xls
还是不会，麻烦路十千帮我看看。

Answer 1

Sub Macro1()
Application.DisplayAlerts = False
Worksheets(Worksheets.Count).Delete '删除最后一个工作表
For i = 70 To 367
s = i & " " & Range("b6")
ActiveWorkbook.SaveCopyAs Filename:="D:\My Documents\信用村评定\" & s & ".xls", _
FileFormat:=xlExcel8
Next
Application.DisplayAlerts = True
End Sub

追问

由于前面的工作簿要从最后一个工作簿中取数，把最后一个工作簿删掉后前面的工作簿就显示错误值，还清高人帮忙看看，我已上传到了百度盘。
http://pan.baidu.com/s/13ltQ9

追答

前面工作表有对最后一个工作表的引用，（是工作表不是工作簿），源表删除引用该源的地方会出现错误。那为什么还要删除最后一张表？看上去sheet1是一个明细汇总，其他表的数据都是对它的引用，不太理解你为什么要删除它。说明白你的最终要求，看还能不能帮到你。

追问

因为要分拆开来一户一个文件用于上传到服务器，如果每一户文件里都带上了明细表，上传的时候文件太大，不方便上传，服务器端有限制，不能超过30兆，如果没有明细表我可以1000个文件放一起压缩再上传，带了明细表只能压缩几十个，而且服务器端不支持批量上传，只能单个文件上传。

追答

若仅仅只是为了上传的话，可以改一下结构，把sheet1做成一个单一的工作簿，其他的工作簿中的工作表都引用单工作簿的sheet1，这样若可行还是比较方便的。若不行那就只能把需要的表都复制到一个新工作簿里再保存出去，只是这样速度会较慢。

追问

你的意思是说把sheet1里的明细存一个文件，用于上传的另存为一个文件是吗？
表格里公式有些地方用的是offset，我试了一下，需要同时打开两年文件才能看得到，如果源文件不打开，表格文件会出错，就算是打开的，压缩后上传了再看也还是错的。可能表格里的公式需要改动。

追答

sheet1单列出去后其他表引用sheet1的公式肯定要修改的，修改公式是细节先不说，先说这样更改结构对使用这些表的用户会不会有妨碍或者其他的不方便，如没问题就可以改。不知道表上传到服务器后最终会流向哪里，若服务器只是用于备份，表的使用者还是你自己，就没问题。若最终流向很多用户那就不太合适了。
下面是把除了最后那张表外其余的表都保存到一个新文件里的代码，并且去掉了所有表里的公式，哪儿有不合适你可以修改一下。由于要创建和保存文件，比较费时的。
代码要放到模块中。

Sub 另存()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
t = Timer
n = Val(Sheets("sheet1").[a65536].End(3)) 'sheet1表A列最后一个单元格的值
ReDim arr(1 To Sheets.Count - 1)
For i = 1 To Sheets.Count - 1
arr(i) = Sheets(i).Name
Next
For j = 1 To n
Sheets("农户基本信息").Range("c7") = j
s = j & " " & Sheets("农户基本信息").Range("b6")
Sheets(arr).Copy
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
sh.UsedRange = sh.UsedRange.Value
Next
ActiveWorkbook.SaveAs Filename:="D:\My Documents\信用村评定\龙咀\" & s & ".xls", _
FileFormat:=xlExcel8
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "OK!" & Format(Timer - t, " 用时 0.0 秒"), vbInformation
End Sub