Excel工作簿中工作表分别保存为文件


Sub fenchai()
On Error Resume Next
Dim WB As Workbook, i As Integer
Set WB = ThisWorkbook
For i = 1 To WB.Worksheets.Count '获得工作簿中表的个数
WB.Worksheets(i).Copy '复制工作表
ActiveWorkbook.SaveAs Filename:="c:\分拆文档\" & WB.Worksheets(i).Name & "TB.xls" '保存文档
ActiveWindow.Close
Next i
End Sub

再见,CPH

LampDrive(前身为CPH)最近接上级通知,对低俗及不健康信息,未备案的,以及欠费的用户进行了清理,我和赵大小姐的博客也在其中。很不好意思,我被关闭的原因是欠费,一言难尽,按下不表吧。
今天正式将博客转入Slicehost,感觉速度比CPH略慢,但也在可忍受范围内,因为有了SSH,实际使用起来更加方便了。
翻译克鲁格曼的blog,由于停止翻译很久了,暂时不启用,重新启用后,也将会转入blogspot。

好了,搬家结束,以后就跟着麦克混了,超喜欢他博客的STYLE。

如何将excel工作薄中的单列数据复制到不同的新工作簿中

汇总报表中单列公司的数据要分发到下属公司,如果每一列都复制到新工作簿另存,工作很大,所以编写了一段VBA来代替重复的手工劳动
Sub add_new()
On Error Resume Next
With Worksheets("Detail line-consolidation") '汇总报表
For i = 3 To 35
Dim fname As String
fname = .Cells(3, i) '取公司名称
Dim mybook As Workbook
Set mybook = Workbooks.Add
mybook.SaveAs "d:\vba\" & fname & ".xls"
col = Split(Cells(3, i).Address, "$")(1) '取列名
.Range("a2:b169").Copy
Windows(fname & ".xls").Activate
Range("a1").PasteSpecial
.Range(col & "2:" & col & "169").Copy
Windows(fname & ".xls").Activate
Range("c1").PasteSpecial
Workbooks(fname & ".xls").Close savechanges:=True
Set mybook = Nothing
Next i
End With
End Sub