Question

我希望将工作表复制到新文件中。每个国家/地区都应保存每个文件 - 事实上，每个国家/地区都有不同的工作表（客户端），列表可能会在将来发生变化。所以我创建了这样的列表，以便将来能够轻松编辑代码，这当然列在Excel Worsheet中：

Sales Org     Tabs

BE01          Albro

DK01          Stockmann", "Mister", "Ginsborg

IT01          La Rinascente", "Arcobaleno

在专栏＆＃34;标签＆＃34;我列出了我希望每个文件复制的表格，而销售组织代表文件名。

我的代码适用于BE01，但是当涉及到DK01时，我会收到＆＃34;下标超出范围＆＃34;错误...

任何人都可以告诉我如何解决这个问题吗？

    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

您可以使用以下模式动态选择多个工作表：

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更改为由适当字符分隔的工作表名称，例如管道符（＆＃34; |＆＃34;），然后使用上面的内容。 Worksheet.Select方法有一个名为＆＃34;替换＆＃34;的选项参数，并将其设置为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。

Answer 2

嘿谢谢你的建议，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

使用动态数组复制工作表

2 个答案: