Question

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

文件1-复制Transposed.xlsm包含“Copy Transposed”，“Test1”， “Test2”，“Test3”，“Test4”，“Test5”。
文件2-复制转置（2）.xlsm包含“复制转置（2）”， “Test1”，“Test2”，“Test3”，“Test4”，“Test5”。
文件3-复制转置（3）.xlsm包含“复制转置（3）”， “Test1”，“Test2”，“Test3”，“Test4”，“Test5”。
文件4-复制转置（4）.xlsm包含“复制转置（4）”， “Test1”，“Test2”，“Test3”，“Test4”，“Test5”。
文件5-复制转置（5）.xlsm包含“复制转置（5）”， “Test1”，“Test2”，“Test3”，“Test4”，“Test5”。

“复制转置”工作表的数量始终不同

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

我对下面的宏进行了现场测试，并让它发挥作用。此宏查找带有字符串＆＃34; Copy Transposed＆＃34;的任何工作表，并创建一个工作簿，其中包含找到的工作表和工作表＆＃34; Test1＆＃34;通过＆＃34; Test5＆＃34;。我想有更优雅的方法来实现你所寻找的东西，但这似乎有效。

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实例填充的工作表。

让我知道这是否能实现你想要实现的目标。

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

1 个答案: