[已解决]除了menu页，其他页子另存为一个总的工作薄怎么操作！！！

dsmch

拆分前后的工作表格式完全一致，文件名和路径自己试着修改一下

zte10157616

dsmch 发表于 2014-3-30 13:17
拆分前后的工作表格式完全一致，文件名和路径自己试着修改一下

大侠拆分倒是会了，

我想要其他的表所有一起导出到一个新的工作薄中（sheet名不变），再帮忙看看？

zte10157616

dsmch 发表于 2014-3-30 13:17
拆分前后的工作表格式完全一致，文件名和路径自己试着修改一下

我现在就是先另存一个备份工作薄，然后打开备份工作薄，删除Menu页，这样比较折腾！！！

有没有一步到位的代码。

dsmch

zte10157616 发表于 2014-3-30 13:52
我现在就是先另存一个备份工作薄，然后打开备份工作薄，删除Menu页，这样比较折腾！！！

有没有一步到 ...

看来楼主不会举一反三，没有真正学会

zte10157616

dsmch 发表于 2014-3-30 14:17
看来楼主不会举一反三，没有真正学会

是呀，才学没几天啊！工作薄操作，还是比较绕啊！

求大侠给指点啊！

dsmch

Sub Macro1()
On Error Resume Next
Dim i&, zf$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Menu" Then
        zf = Sheets(i).Name & ".xls" '文件名
        With Workbooks.Add
            For j = 2 To ThisWorkbook.Sheets.Count
                ThisWorkbook.Sheets(j).Copy after:=.Sheets(.Sheets.Count)
            Next
            .Sheets(1).Delete
            .SaveAs Filename:=ThisWorkbook.Path & "\" & zf '路径+文件名
        End With
        Workbooks(zf).Close 1
    End If
Next
Application.SheetsInNewWorkbook = 3
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

zte10157616

dsmch 发表于 2014-3-30 14:23
Sub Macro1()
On Error Resume Next
Dim i&, zf$

搞定，把i的否循环去掉即可！如下，With workbooks.add妙啊。我之前老是with 程序工作薄；

ThisWorkbook.Sheets(j).Copy after:=.Sheets(.Sheets.Count)

after:=.Sheets(.Sheets.Count) 这个能否注解一下，尤其是=号后边的，

1. Function lingcun()
   
2. On Error Resume Next
   
3. Dim i&, zf$
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Application.SheetsInNewWorkbook = 1
   
7.     If Sheets(i).Name <> "Menu" Then
   
8.         zf = "ommb_tdd_radio_new_" & Format(Date, "yyyymmdd") & Format(Time, "hhmmss") & ".xlsx" '文件名
   
9.         With Workbooks.Add
   
10.             For j = 2 To ThisWorkbook.Sheets.Count
    
11.                 ThisWorkbook.Sheets(j).Copy after:=.Sheets(.Sheets.Count)
    
12.             Next
    
13.             .Sheets(1).Delete
    
14.             .SaveAs Filename:=ThisWorkbook.Path & "" & zf '路径+文件名
    
15.         End With
    
16.         Workbooks(zf).Close 1
    
17.     End If
    
18. Application.SheetsInNewWorkbook = 3
    
19. Application.DisplayAlerts = True
    
20. Application.ScreenUpdating = True
    
21. End Function

复制代码

dsmch

zte10157616 发表于 2014-3-30 14:57
搞定，把i的否循环去掉即可！如下，With workbooks.add妙啊。我之前老是with 程序工作薄；

ThisWorkbo ...

复制工作表到新建工作簿的最后位置

zte10157616

dsmch 发表于 2014-3-30 15:08
复制工作表到新建工作簿的最后位置

求大侠QQ号！我要拜师！

dsmch

zte10157616 发表于 2014-3-30 16:04
求大侠QQ号！我要拜师！

拜师不敢当，有事在论坛发信息联系，不大上QQ