我有几个相同的工作表,名为“复制转置”(复制转置,复制转置(2),复制转置(3)等)。我想要写一个宏,它将复制一个带有"Test1“、"Test2”、"Test3“、"Test4”、"Test5“的拷贝。因此,如果我有5个副本转置工作表,我希望有5个独立的文件与副本转置和"Test1","Test2","Test3","Test4","Test5“。文件的名称应该与活动工作表的名称相同。例如,我有5份已转换的工作表副本,因此:
“复制转置”工作表的数量总是不同的。
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
发布于 2017-11-21 15:45:20
我对下面的宏进行了测试,并使其正常工作。此宏查找字符串“复制转置”的任何工作表,并通过"Test5“创建带有工作表和工作表”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新实例的工作表。
如果这达到了你想要达到的目标,请告诉我。
https://stackoverflow.com/questions/47416194
复制相似问题