将工作表分开并保存为单独的文件

我有几个相同的工作表名为“复制转置”（复制转置，复制转置（2），复制转置（3）等）我想写一个macros将复制一个复制转置*工作表与“Test1” “Test2”，“Test3”，“Test4”，“Test5”。 所以，如果我有5个复制转置的工作表，我想有5个独立的文件复制转置和“Test1”，“Test2”，“Test3”，“Test4”，“Test5”。 该文件的名称应该与活动工作表的名称相同。 例如，我有5个复制转置的工作表，所以：

• 文件1-复制Transposed.xlsm包含“复制转置”，“testing1”，“testing2”，“testing3”，“testing4”，“testing5”。

• 文件2-复制转置（2）.xlsm包含“复制转置（2）”，“testing1”，“testing2”，“testing3”，“testing4”，“testing5”。

• 文件3-复制转置（3）.xlsm包含“复制转置（3）”，“testing1”，“testing2”，“testing3”，“testing4”，“testing5”。

• 文件4-复制转置（4）.xlsm包含“复制转置（4）”，“testing1”，“testing2”，“testing3”，“testing4”，“testing5”。

• 文件5-拷贝转置（5）.xlsm包含“拷贝转置（5）”，“testing1”，“testing2”，“testing3”，“testing4”，“testing5”。

“复制转换”工作表的数量总是不同的

Sub test_macro() Dim Fname As String Fname = Sheets("Copy Transposed").Range("A1").Value Sheets(Array("Test1", "Test2", "Test3", "Test4", "Test5")).copy With ActiveWorkbook ActiveWorkbook.SaveAs ThisWorkbook.path & "\" & Fname & ".xlsm", FileFormat:=52 End With End Sub 

Answer 1

我对下面的macros进行了现场testing，并且开始工作。 此macros将查找任何工作表与string“复制转置”，并创build一个工作簿与工作簿find工作表，并与工作表“Test1”通过“Test5”。 我想有更多的优雅的方式来实现你正在寻找的，但这似乎工作。

 Sub Test() Dim WS As Worksheet Dim WB As Workbook Dim SearchStr As String Dim ShtName As String Dim FName As String Dim FPath As String Dim WBNew As Workbook Set WB = ActiveWorkbook SearchStr = "Copy Transposed" FPath = "C:\Users\hwyr53e\Desktop\Test Output\" For Each WS In WB.Sheets ShtName = WS.Name Set wshts = Sheets(Array("Test1", "Test2", "Test3", "Test4", "Test5")) If InStr(ShtName, SearchStr) > 0 Then FName = FPath & ShtName & ".xlsm" Set WBNew = Workbooks.Add wshts.Copy before:=WBNew.Sheets(1) WS.Copy before:=WBNew.Sheets(1) With WBNew .SaveAs FName, FileFormat:=52 End With WBNew.Close Set WBNew = Nothing End If Next WS End Sub 

您可能需要添加组件以删除使用新的Excel实例填充的工作表。

让我知道这是否完成了你想要实现的。