有 15 张工作表,我需要将选定工作表的内容复制到新工作簿中(每张工作表一个工作表)。
下面的 VBA 有效,但我有一个部分我无法弄清楚。我从中复制的每张表都包含一个数据透视表,并且我不希望复制数据透视函数 - 只复制数据。文件大小更小。
通过手动,我可以跳过数据透视表的顶部并复制“A4:BF & lr”。粘贴后,枢轴功能消失了。但我不知道如何添加通常的:
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A4:BF" & lr).Copy
...进入我的vba(它不会运行)。我想最简单的方法是如果有一个功能可以让我在没有枢轴功能的情况下复制整个工作表,但我也不知道如何将其拉下来......有什么想法吗?
Sub Test_KIT()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 4) = "s2g1" Or Left(ws.Name, 4) = "s2g2" Then
ws.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\ABC1_999_" & ws.Name & ".xlsx"
ActiveWorkbook.Close SaveChanges:=False
End If
Next ws
End Sub
最佳答案
通过使用 BigBen的想法,以及其他一些变化,这段代码现在正在做我想做的事情。非常感谢您的帮助!
Sub Test_KIT4()
Dim ws As Worksheet
Dim NewBook As Workbook
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
Set NewBook = Workbooks.Add
If ws.Name <> "DATA_ske_ferdigFU" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A4:BF" & lr).Copy
NewBook.ActiveSheet.Paste
NewBook.SaveAs ThisWorkbook.Path & "\ABC1_999_" & ws.Name & ".xlsx"
NewBook.Close SaveChanges:=False
End If
Next ws
NewBook.Close SaveChanges:=False
End Sub
关于excel - VBA将多张纸从一个wb复制到新的wb中(每张纸一个wb),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/61108920/