Question

我有一个工作簿，其中有很多工作表，我们将其称为“ A型”工作表，而在同一工作簿中有相等数量的“ B型”工作表对应于给定的A型工作表。

为简单起见，假设我的工作表是：红色，黄色，蓝色，深红色，深黄色然后深蓝色。我想将两个红色表都复制到一个全新的工作簿，然后将两个黄色表都复制到另一个新的工作簿，依此类推。我还希望新工作簿文件的名称是A型文件的名称（例如Red）。任何帮助将不胜感激。

这是我到目前为止的VBA。我可以将第一个组合复制到一个新的工作簿（即两个红色），但是之后我收到一个“ 424”错误。我正在使用“ i”循环，并按其编号参考图纸以简化/概括。

Sub export2sheets()
Dim twb As Workbook
Set twb = ThisWorkbook
Dim i As Integer
XPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To 2
    twb.Activate
    Worksheets(Array(i, (i + 2))).Copy
    With ActiveWorkbook
         Application.ActiveWorkbook.SaveAs Filename:=XPath & "\" & xWs.Name & ".xlsx"
         Application.ActiveWorkbook.Close False
    End With
    Workbooks.Add
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

编辑1 ：以下代码可以正常工作，但是它没有按预期命名文件或关闭文件，表面上是因为我删除了代码行。

Sub export2sheets()
Dim twb As Workbook
Set twb = ThisWorkbook
Dim i As Integer
XPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To 2
    twb.Activate
    Worksheets(Array(i, (i + 3))).Copy
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

编辑2 ：最新代码如下。

我使用n来概括文件/ A型表的数量。
我已删除与xPath相关的所有内容。
我已将xWs更改为Worksheets(i)。
我已删除Application.ActiveWorkbook。
我已将Close False更改为Close True，因为我希望完成后关闭文件。

任何想法，为什么在SaveAs行中按F8键时，该代码却给我一个“ 52”错误代码？它当前执行到SaveAs为止，因此它不会更改文件名或关闭文件。另外，由于某些原因，Save和Close False可以工作，但是如果使用SaveAs或Close True，则它们不起作用。

Sub export2sheets()
    Dim twb As Workbook
    Set twb = ThisWorkbook
    Dim i As Integer
    Dim n As Integer
    n = 3 'set n = the number of type A files
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = 1 To n
        twb.Worksheets(Array(i, (i + n))).Copy
        SaveAs Filename:=Worksheets(i).Name & ".xlsx"
        Close True
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

VBA是否可以将2张纸的不同组合重复地从一个主工作簿复制到新工作簿？

0 个答案: