Arrays 使用动态数组复制工作表

我想将工作表复制到新文件中。每个文件都应该按国家/地区保存-问题是，我在每个国家/地区都有不同的工作表（客户端），并且列表将来可能会更改。因此，我创建了这样的列表，以便将来能够轻松编辑代码，这当然列在Excel工作表中：

Sales Org     Tabs

BE01          Albro

DK01          Stockmann", "Mister", "Ginsborg

IT01          La Rinascente", "Arcobaleno

在“选项卡”列中，我列出了每个文件要复制的图纸，销售组织表示文件名

我的代码在BE01的情况下工作，但是当涉及到DK01时，我收到“下标超出范围”错误

谁能告诉我怎么解决这个问题吗

    Sub SaveFile()
'
Dim Savefolder As String
Dim Filetype As String
Dim Filename As String
Dim lastrow As Integer
Dim Name As String
Dim Eufile As String
Dim TodayDate As String
Dim list As String


lastrow = Sheets("Macro Control").Range("A1048576").End(xlUp).Row
Savefolder = Sheets("Macro Control").Range("D2")
Filetype = Sheets("Macro Control").Range("E2")
Filename = Sheets("Macro Control").Range("F2")
 TodayDate = Format(Date, "dd.mm.yyyy")

    Dim array_db() As String
   ReDim array_db(lastrow - 2, 1)


    For row_number = 2 To lastrow

    array_db(row_number - 2, 0) = Sheets("Macro Control").Range("A" & row_number)
    array_db(row_number - 2, 1) = Sheets("Macro Control").Range("B" & row_number)
  Next

    For i = 0 To UBound(array_db)

            list = array_db(i, 1)
        Sheets(Array(list)).Copy
    Name = array_db(i, 0)
       Eufile = Savefolder & "\" & Filename & " " & TodayDate & " " & Name & Filetype



   ActiveWorkbook.SaveAs Filename:=Eufile
   ActiveWorkbook.Close

    Next


End Sub

---

可以使用以下模式动态选择多张图纸：

Dim sheetnames, i As Long

sheetnames = Split("Sheet1|Sheet2|Sheet3", "|")
Worksheets(sheetnames(0)).Select

For i = LBound(sheetnames) + 1 To UBound(sheetnames)
    Worksheets(sheetnames(i)).Select False
Next

换言之，将B列更改为图纸名称，并用适当的字符分隔，例如管道字符（“|”），然后使用上述字符。工作表.Select方法有一个名为“Replace”的选项paramater，如果将其设置为false，则表示除了当前选定的工作表之外，还将选择该工作表

编辑：

顺便说一下，您不必逐个将单元格值读入数组。您可以使用变体阵列一步完成所有操作：

Dim array_db() as variant

array_db = Sheets("Macro Control").Range("A2").Resize(lastrow-1,2).Value

---

还建议指定要获取哪个维度的ubound:ubound（array_db，1）。您的代码之所以有效，是因为默认情况下它会找到第一个维度的ubound，但这并不总是您想要的ubound。

嘿，谢谢您的建议，SPLIT帮助：我就是这样解决的：

sheetnames = Split(array_db(i, 1), "|")

    Sheets(sheetnames).Copy

当然，上面我说了我从哪里获取数组_db。。。不管怎样，“拆分”使使用单个单元格中的文本作为要复制的选项卡列表成为可能。。。我也没有申报“sheetnames”

简化代码如下：

  Sub SaveFile()

Dim lastrow As Integer




lastrow = Sheets("Sheet1").Range("A1048576").End(xlUp).Row

    Dim array_db()
   ReDim array_db(lastrow - 2, 1)


    For row_number = 2 To lastrow

    array_db(row_number - 2, 0) = Sheets("Sheet1").Range("A" & row_number)
    array_db(row_number - 2, 1) = Sheets("Sheet1").Range("B" & row_number)
  Next

    For i = 0 To UBound(array_db)

sheetnames = Split(array_db(i, 1), "|")

    Sheets(sheetnames).Copy





    Next


End Sub

---

在代码的何处生成错误？当代码在行工作表（数组（列表））的第二个循环中时。复制，所以当它应该复制多个工作表时，请复制！我使用了您的代码，所选内容正在按我的需要工作，但我如何才能将所选工作表复制到新工作簿？您可以使用ActiveWindow.SelectedSheets.copy复制所选工作表。