使用dynamic数组复制工作表

我想复制工作表到新文件。 每个文件都应该保存每个国家 – 事情是我有不同的工作表（客户端）每个国家和名单可能会改变将来。 所以我创build了这样的列表就可以很容易地编辑将来的代码，这当然在Excel Worsheet中列出了：

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 

Answer 1

您可以使用以下模式dynamicselect多个工作表：

 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更改为由合适的字符（例如pipe道字符（“|”））分隔的工作表名称，然后使用上述内容。 Worksheet.Select方法有一个名为“Replace”的参数选项，将其设置为false意味着除了当前选定的工作表之外，还将select工作表。

编辑：

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

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

UBound（array_db，1）也是明智的。 你的代码工作，因为它默认情况下find第一维的ubound，但这并不总是你想要的ubound。

Answer 2

嘿谢谢你的build议，SPLIT帮助：这是我如何解决它：

 sheetnames = Split(array_db(i, 1), "|") Sheets(sheetnames).Copy 

当然，上面我说我从哪里采取array_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