[已解决]求VB代码~！

mqvh · 发表于 2011-5-24 15:51

本帖最后由 mqvh 于 2011-5-24 16:55 编辑

请教高手！~
我想想要这样一个代码

要求：
1.通过VB把某个“工作薄”中的“工作表”分别以"工作表"的名称命名为新的"工作薄"，并另存在同一路径下。
2.新建的工作薄里面的数据不能有公式，只要求赋值

最佳答案

月排行榜 / 总排行榜

天马

2011-5-25 11:07

本帖最后由天马于 2011-5-25 11:29 编辑

mqvh 发表于 2011-5-24 17:38
回复天马的帖子

文件名全有了，里面的数据没了！

不好意思，没有弄清你的问题，没有复制工作表的数据，现更新如下再试看

Sub tset()
Dim sht As Worksheet
Dim Wkb As Workbook
Dim Nam$
For Each sht In Worksheets
sht.Cells.Copy
Nam = sht.Name
Set Wkb = Workbooks.Add
Wkb.Worksheets(1).Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Wkb.SaveAs Nam
Wkb.Close
Next
End Sub

复制代码

新建文件夹 (3).rar (6.98 KB, 下载次数: 1)

Aifer · 发表于 2011-5-24 15:55

录制宏修改一下就可以了

mqvh · 发表于 2011-5-24 16:29

本帖最后由 mqvh 于 2011-5-24 17:02 编辑

回复 Aifer 的帖子

要求：
1.通过VB把某个“工作薄”中的“工作表”分别以"工作表"的名称命名为新的"工作薄"，并另存在同一路径下。
2.新建的工作薄里面的数据不能有公式，只要求赋值

宏对固定工作表有用当不确定工作表时宏没有用的

Private Sub CommandButton1_Click()
Dim sheet_n
For Each sheet_n In Sheets
sheet_n.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close
Next
MsgBox "另存完成，请查看！"
End Sub

以上这段代码新建的工作薄里面的数值有公式，请高手更改下！~

天马 · 发表于 2011-5-24 17:21

Sub tset()
Dim sht As Worksheet
Dim Wkb As Workbook
Dim Nam$
For Each sht In Worksheets
Nam = sht.Name
Set Wkb = Workbooks.Add
Wkb.SaveAs Nam
Wkb.Close
Next
End Sub

复制代码

新建文件夹 (3).rar (7.93 KB, 下载次数: 4)

mqvh · 发表于 2011-5-24 17:32

回复天马的帖子

哥不行啊！~！

mqvh · 发表于 2011-5-24 17:38

回复天马的帖子

文件名全有了，里面的数据没了！

mqvh · 发表于 2011-5-24 18:23

回复 mqvh 的帖子

自己顶下

那么的帅 · 发表于 2011-5-24 22:56

请提供示例数据

mqvh · 发表于 2011-5-25 08:34

回复那么的帅的帖子

上附件~！~！

天马 · 发表于 2011-5-25 11:07

本帖最后由天马于 2011-5-25 11:29 编辑

mqvh 发表于 2011-5-24 17:38
回复天马的帖子

文件名全有了，里面的数据没了！

不好意思，没有弄清你的问题，没有复制工作表的数据，现更新如下再试看

Sub tset()
Dim sht As Worksheet
Dim Wkb As Workbook
Dim Nam$
For Each sht In Worksheets
sht.Cells.Copy
Nam = sht.Name
Set Wkb = Workbooks.Add
Wkb.Worksheets(1).Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Wkb.SaveAs Nam
Wkb.Close
Next
End Sub

复制代码

新建文件夹 (3).rar (6.98 KB, 下载次数: 1)

		自动登录	找回密码
密码			注册