VBA 宏将工作表复制并粘贴到新工作簿中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/45920991/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Macro to copy and paste sheets into new workbook
提问by GrandeurH
I do a report every day in which I have to copy and paste several sheets into a new workbook titled Report (today's date).
我每天都做一份报告，其中我必须将几张纸复制并粘贴到名为“报告”（今天的日期）的新工作簿中。
In my report I have 4 sheets : Customers, Orders, Country, ID.
在我的报告中，我有 4 张表：客户、订单、国家/地区、ID。
Customer and Country are a simple copy and paste from the master file, but Orders and ID are filtered data from one of my sheets in the master file. Orders is filtered to "Complete" and Id is everything except ID 200 and 500.
客户和国家/地区是从主文件中简单复制和粘贴，但订单和 ID 是从主文件中我的一张工作表中过滤的数据。订单被过滤为“完成”，而 ID 是除 ID 200 和 500 之外的所有内容。
I tried building a macro based on this solution found here : http://www.hivmr.com/db/ack717pc8f88jpdsf7838pcaspkcsdmd
我尝试根据此处找到的解决方案构建宏：http: //www.hivmr.com/db/ack717pc8f88jpdsf7838pcaspkcsdmd
The copy and paste works but I am unable to copy and paste multiple sheets/ rename sheets and filter the data.
复制和粘贴有效，但我无法复制和粘贴多个工作表/重命名工作表并过滤数据。
Edit:
编辑：
Sub CopyInNewWB()
'has been tested
Dim newWS, WS As Worksheet
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets("Sheet1")
Set newWS = Workbooks.Add.Sheets("Sheet1")
WS.Cells.Copy
newWS.Cells.PasteSpecial xlValues Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
采纳答案by barvobot
No clue how your filtered sheets are set up, but this method will copy the sheets in your master exactly how they are currently filtered to a new workbook:
不知道您过滤的工作表是如何设置的，但是此方法会将您的母版中的工作表准确地复制它们当前过滤到新工作簿的方式：
Sub CopyInNewWB()
Dim wbO As Workbook, wbN As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbO = ActiveWorkbook
Set wbN = Workbooks.Add
wbO.Sheets("Customers").Copy wbN.Sheets(1)
wbO.Sheets("Orders").Copy wbN.Sheets(2)
wbO.Sheets("Country").Copy wbN.Sheets(3)
wbO.Sheets("ID").Copy wbN.Sheets(4)
wbN.Sheets("Sheet1").Delete
wbN.Sheets("Customers").Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
