macros，使用数组将工作表复制到不同的工作簿

我们有一个SSRS报告，每个部门都有一个单独的工作表。 我们运行一个macros，将所有的工作表重命名为部门名称，然后将特定的工作表复制到新的工作簿，通过​​电子邮件发送给部门。 与代码的问题是，如果其中一个部门没有工作表的那个月macros错误与“不在指定范围内”的错误。 有没有办法告诉它忽略丢失的工作表，如果他们不存在这次？ 这里是代码：

Sheets(Array("AB", "CD", "EF", "GH", "IJ", "KL")).Copy Sheets("AB").Select ActiveWorkbook.SaveAs Filename:= _ Path & "Holder Agings " & Today & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False 

谢谢！

Answer 1

我同意Rusan Kax，没有完整的代码块，很难准确地生成你需要的代码。 下面的代码显示了两种技术。 你应该能够适应你的要求之一。

 Option Explicit Sub Test1() ' Demonstrate CheckWshts(Array) which removes names from the array ' if they do not match the name of a worksheet within the active ' workbook Dim InxWsht As Long Dim WshtTgt() As Variant WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL") Call CheckWshts(WshtTgt) For InxWsht = LBound(WshtTgt) To UBound(WshtTgt) Debug.Print WshtTgt(InxWsht) Next End Sub Sub Test2() ' Demonstrates WorksheetExists(Name) which returns True ' if worksheet Name is present within the active workbook. Dim InxWsht As Long Dim WshtTgt() As Variant WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL") For InxWsht = LBound(WshtTgt) To UBound(WshtTgt) If WorksheetExists(CStr(WshtTgt(InxWsht))) Then Debug.Print WshtTgt(InxWsht) & " exists" Else Debug.Print WshtTgt(InxWsht) & " does not exist" End If Next End Sub Sub CheckWshts(WshtTgt() As Variant) ' * WshtTgt is an array of worksheet names ' * If any name is not present in the active workbook, ' remove it from the array Dim Found As Boolean Dim InxWshtActCrnt As Long Dim InxWshtTgtCrnt As Long Dim InxWshtTgtMax As Long InxWshtTgtCrnt = LBound(WshtTgt) InxWshtTgtMax = UBound(WshtTgt) Do While InxWshtTgtCrnt <= InxWshtTgtMax Found = False For InxWshtActCrnt = 1 To Worksheets.Count If Worksheets(InxWshtActCrnt).Name = WshtTgt(InxWshtTgtCrnt) Then Found = True Exit For End If Next If Found Then ' Worksheet WshtTgt(InxWshtTgtCrnt) exists InxWshtTgtCrnt = InxWshtTgtCrnt + 1 Else ' Worksheet WshtTgt(InxWshtTgtCrnt) does not exist WshtTgt(InxWshtTgtCrnt) = WshtTgt(InxWshtTgtMax) InxWshtTgtMax = InxWshtTgtMax - 1 End If Loop ' Warning this code does not handle the situation ' of none of the worksheets existing ReDim Preserve WshtTgt(LBound(WshtTgt) To InxWshtTgtMax) End Sub Function WorksheetExists(WshtName As String) ' Returns True is WshtName is the name of a ' worksheet within the active workbook. Dim InxWshtCrnt As Long For InxWshtCrnt = 1 To Worksheets.Count If Worksheets(InxWshtCrnt).Name = WshtName Then WorksheetExists = True Exit Function End If Next WorksheetExists = False End Function 

Answer 2

由于Worksheets集合没有提供任何方法来允许我们检查特定工作表名称是否代表有效表单，因此我们必须遍历所有工作表名称，并尝试将项目从集合中取出。 这里的On Error Resume Next例子，如果特定的名称不代performance有的工作表，它会忽略错误。 这样， allNames数组将被过滤，并且无效名称不会被添加到仅包含有效名称的新数组names中。

 Public Sub test() Dim allNames As Variant Dim names As Variant Dim name As Variant Dim someSheet As Worksheet allNames = Array("AB", "CD", "EF", "GH", "IJ", "KL") On Error Resume Next For Each name In allNames Err.Number = 0 Set someSheet = Worksheets(name) If Err.Number <> 0 Then _ GoTo continue If IsArray(names) Then ReDim Preserve names(UBound(names) + 1) Else ReDim names(0 To 0) End If names(UBound(names)) = name continue: Next name On Error GoTo 0 If Not IsArray(names) Then _ Exit Sub Sheets(names).Copy ' your code ... End Sub