VBA宏将工作表复制并粘贴到新工作簿中

我每天都要做一份报告，在报告中，我必须将几张纸复制并粘贴到名为“报告”（今天的日期）的新工作簿中

在我的报告中，我有4张表格：客户、订单、国家、ID

客户和国家是主文件中的简单复制和粘贴，但订单和ID是从主文件中我的一张工作表中筛选出来的数据。订单被过滤为“完成”，Id是除Id 200和500之外的所有内容

我尝试基于以下解决方案构建宏：

复制和粘贴可以工作，但我无法复制和粘贴多张图纸/重命名图纸并过滤数据

编辑：

---

不知道过滤后的工作表是如何设置的，但此方法会将主工作簿中的工作表复制到一个新工作簿中，即当前的过滤方式：

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

---

你能给我们看一下你一直在使用的代码吗？我的道歉我以为我发布了它的sub CopyInNewWB（）'已经过测试了Dim newWS，WS As worket Application.ScreenUpdate=False Set WS=ThisWorkbook.Sheets（“Sheet1”）Set newWS=workbook.Add.Sheets（“Sheet1”）WS.Cells.Copy newWS.Cells.pasteValues Application.CutCopyMode=False Application.ScreenUpdate=True End sub最好编辑您的问题并包含该代码，而不是作为注释发布。格式限制在注释中，正如您所看到的，它只是一起运行。您好，非常感谢您的帮助，它工作得非常完美。但是有没有办法告诉宏过滤数据？我的数据是在表格中设置的，所以过滤器只是您的基本过滤器。每天我都会过滤订单单，直到它刚刚完成（我有一个标题，其中它是一个过滤器），然后复制并粘贴到一个新的表单中，然后我取消过滤并过滤标题为ID的列，除了200和500之外的所有内容。如果有任何方法可以做到这一点，它将非常感谢和帮助！我需要查看一些示例数据，并知道主数据中的哪些表正在被过滤/复制到报告中的何处

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