多次复印多张纸

Question

感谢您为像我们这样的新手建立一个强大的社区。​​p>

我正在尝试构建一个宏，该宏可以根据用户通过谷歌搜索的输入多次复制多个选定的工作表，但我遇到了一些麻烦。

这里的问题是，虽然代码确实多次复制了多张工作表，但它失去了链接。

例如 - 我在工作簿中有标题为 A、B 和 C 的工作表，工作表 B 有一些链接到工作表 A 的单元格，类似地工作表 C 有一些链接到工作表 B 的值，当使用此宏时，它会创建副本一张一张。因此，如果我在选择工作表 B 和 C 后提到 4 个副本，它将创建 B 的第一个副本，然后是 C 的第一个副本，然后是 B 的第二个副本，然后是 C 的第二个副本，依此类推，直到循环结束。

但是我想要的是它同时选择两张纸然后创建副本。这是因为当我们手动执行此操作时，工作表中的链接会被修改为新创建的工作表。我的意思是，当我们选择工作表 B 和 C，然后手动创建副本时，工作表 C 将显示链接到新创建的工作表 B。

我不确定这是否可以通过 VBA 完成，但帖子显示这可以通过一些我不知道的数组函数来完成。

任何帮助将不胜感激。

我不知道如何添加文件或添加我拥有的代码到这个论坛，因此我在这里添加了它

Sub MultiSheetArray()

'allows you to store an array of sheets

Dim ws As Worksheet

Dim ShtArray() As String

Dim intA As Integer

Dim intB As Integer
Dim myArray() As Variant

 Dim i As Long
 On Error GoTo endit
 Application.ScreenUpdating = False
 shts = InputBox("How many times")

' First you need to enter the sheet names into an array

For Each ws In ActiveWindow.SelectedSheets

 intA = intA + 1

 ReDim Preserve ShtArray(intA)

 ShtArray(intA) = ws.Name

Next ws



' Now list the sheets we entered into our array "shtArray"

 For i = 1 To shts

For intB = 1 To intA

ActiveWorkbook.Worksheets(myArray(x)).Copy after:=ActiveSheet

Next intB

 Next i
 Application.ScreenUpdating = True
endit:


End Sub

提前致谢。

Answer 1

复制选定工作表的多个实例

• 要测试此过程，请打开一个新工作簿。在VBECRTL+F11中，插入一个标准模块并将代码复制进去。添加一些工作表。现在通过单击第一个选项卡和 CRTL 选择其中一些选项卡 - 单击将创建一组工作表的任何其他选项卡。现在运行首先询问“多少次”的程序。第一次不要输入超过 2 并按 ENTER 看看发生了什么。

守则

Option Explicit

' Copies selected sheets multiple times after the last sheet.
Sub MultiSheetArray()
    
    On Error GoTo endit
    Application.ScreenUpdating = False
    
    ' Input number of copies.
    Dim shts As Long
    shts = InputBox("How many times")
    
    ' Write the names of the selected sheets to an array.
    Dim sh As Object
    Dim ShtArray() As String
    ReDim ShtArray(1 To ActiveWindow.SelectedSheets.Count)
    Dim i As Long
    For Each sh In ActiveWindow.SelectedSheets
        i = i + 1
        ShtArray(i) = sh.Name
    Next sh
    
    ' Copy sheets after last sheet.
    For i = 1 To shts
        With ActiveWorkbook
            .Sheets(ShtArray).Copy After:=.Sheets(.Sheets.Count)
        End With
    Next i
    
    Application.ScreenUpdating = True

endit:

End Sub