用VBA语句拆分工作表到不同的新建工作簿中

wendy23456789

需求：想要把代码所在工作簿中的1月份-6月份，6个工作表移动到新建的六个工作簿中。
但是，我用for each循环代码所在工作簿中的1-6月份，6个表格时，系统报错。我的代码是for each wk in thisworkbook.worksheets(i & "月份")
我的代码如下图所示：（仅看拆分工作表到不同的工作簿中这个宏过程。谢谢！）

limonet

for each wk in worksheets
    if wk.name like "*月份*" then
next wk

longwin

去掉For each 就可以了吧，你已经把表的名称都循环出来了。

longwin

LIUZHU

感觉楼主写的太复杂了，一个批量移动并作为独立工作簿保存，一个过程就够了啊。

LIUZHU

是这样的吧？但只考虑将带月份的工作表作为独立工作簿保存

1. Sub 批量移动工作表并保存()
   
2.     Dim Sh As Worksheet
   
3.     Dim Fname$
   
4.     For Each Sh In Sheets
   
5.         If Sh.Name Like "*月份" Then
   
6.             Fname = ThisWorkbook.Path & "" & Sh.Name & ".xlsx"
   
7.             Sh.Move
   
8.             ActiveWorkbook.SaveAs Fname, 51
   
9.             ActiveWorkbook.Close False
   
10.         End If
    
11.     Next Sh
    
12. End Sub

复制代码

LIUZHU

附件，请审核

ykcbf1100

新写一个吧

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.5
   
2.     Set fso = CreateObject("Scripting.FileSystemObject")
   
3.     p = ThisWorkbook.Path & ""
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     For Each sht In Sheets
   
7.         If InStr(sht.Name, "月份") Then
   
8.             sht.Copy
   
9.             Set wb = ActiveWorkbook
   
10.             wb.Sheets(1).Name = sht.Name
    
11.             wb.SaveAs p & sht.Name
    
12.             wb.Close
    
13.       '      sht.Delete   '//如果要删除原表,加上这句就行了
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17.     Application.DisplayAlerts = True
    
18.     MsgBox "OK！"
    
19. End Sub
    

复制代码

wendy23456789

LIUZHU 发表于 2024-6-5 10:04
附件，请审核

不好意思，我的电脑打不开这个附件，能麻烦您截图发我一下嘛？我学习一下！谢谢啦