CODEWITHSUNDEEP
vbaexcel
Markpb52
Markpb52

Reputation: 1

Macros, using array to copy worksheets to a different workbook

We have an SSRS report that has a separate worksheet for each division. We run a macro to rename all the worksheets with the division name and then copy specific worksheets to a new workbook to be emailed to the divisions. The problem with the code is that if one of the divisions does not have a worksheet that month the macro errors out with an error of "not in specified range". Is there a way to tell it to ignore missing worksheets if they do not exist this time? Here is the code:

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

Thank You!

Upvotes: 0

Views: 194

Answers (1)

Tony Dallimore
Tony Dallimore

Reputation: 12413

I agree with Rusan Kax, without a complete block of code it is difficult to produce exactly the code you need. The code below shows two techniques. You should be able to adapt one of them to your requirements.

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

Upvotes: 2

Related Questions