Create a dynamic array when the number of sheets are variable-CodePudding

I dabble with VBA and working on a inititive for a local school. The project is to build a report to retain student progress, for use during parents evening and school reporting, whihc will streamline to process teaches go throught to gather and easely review an maintqain this data - saving a ton of time for teachers.

The problem I face is each student (variables nbr) have individual sheets. During the year this data needs to be exported to Word.

The code below works but the 'Get my Range Array' is currently fixed, and I would like to make this dynamic, start from sheet 15 and loop through to to the last sheet (Sheets.Count) to create a dynamic array, I can then extract each range from to populate a word document.

CREDIT to @SigmaCoding for providing the base code: (https://youtu.be/giYw24-XZao)

The Sheet: is incremental from 15 to the last sheet The Range: is fixed Sheetx.Range("C141:C157")

Any guidance would be greatly approciated.

Sub Word_Export()
'  Make 'Master Lists' Sheet visible ---------------------------------------------------------------
   Call Add_Child_Sheet
    
' Declare Word Variables ---------------------------------------------------------------------------
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    
' Declare Excel Variables --------------------------------------------------------------------------
    Dim Rng As Variant
    Dim ExlRng As Range
    Dim RngArray As Variant
    
' Declare Report Variables -------------------------------------------------------------------------
    Dim Students As Integer
    Dim Counter As Integer
    Dim Student_Name As String

' Start up Preperation -----------------------------------------------------------------------------
    Application.EnableEvents = False
    Application.Calculation = False

' Open a new instance of Word ----------------------------------------------------------------------
    Set WordApp = New Word.Application
        WordApp.Visible = True
        WordApp.Activate

' Create a new document in Word Application --------------------------------------------------------
    Set WordDoc = WordApp.Documents.Add
        WordDoc.PageSetup.PaperSize = 9

**' Get my Range Array  ----------------------------------------------------------------------------
        RngArray = Array(Sheet15.Range("C141:C157"), Sheet16.Range("C141:C157"), _
                         Sheet17.Range("C141:C157"), Sheet18.Range("C141:C157"), _
                         Sheet19.Range("C141:C157"), Sheet20.Range("C141:C157"), _
                         Sheet21.Range("C141:C157"), Sheet22.Range("C141:C157"), _
                         Sheet23.Range("C141:C157"), Sheet24.Range("C141:C157"), _
                         Sheet25.Range("C141:C157"), Sheet26.Range("C141:C157"), _
                         Sheet27.Range("C141:C157"), Sheet28.Range("C141:C157"), _
                         Sheet29.Range("C141:C157"), Sheet30.Range("C141:C157"), _
                         Sheet31.Range("C141:C157"), Sheet32.Range("C141:C157"), _
                         Sheet33.Range("C141:C157"), Sheet34.Range("C141:C157"), _
                         Sheet35.Range("C141:C157"))**

' Loop through each element in the range Array  ----------------------------------------------------
    For Each Rng In RngArray
    
    ' Create a reference to the range I want to copy -----------------------------------------------
        Set ExlRng = Rng
            ExlRng.Copy
    
    ' Pause Excel Application ----------------------------------------------------------------------
        Application.Wait Now()   #12:00:03 AM#
    
    ' With the current selection paste the Range ---------------------------------------------------
        With WordApp.Selection
            .Paste
            .Tables(1).AutoFitBehavior (wdAutoFitWindow)
        End With
        
    
    ' Set Margins in Word --------------------------------------------------------------------------
        With WordApp.ActiveDocument.PageSetup
            .TopMargin = WordApp.InchesToPoints(0.2)
            .BottomMargin = WordApp.InchesToPoints(0.2)
            .LeftMargin = WordApp.InchesToPoints(0.2)
            .RightMargin = WordApp.InchesToPoints(0.2)
        End With

    ' Create a New Page in Word --------------------------------------------------------------------
        WordApp.ActiveDocument.Sections.Add
        

    ' Go to the New Page in Word -------------------------------------------------------------------
        WordApp.Selection.Goto What:=wdGoToPage, Which:=wdGoToNext

    ' Clear the Clipboard --------------------------------------------------------------------------
        Application.CutCopyMode = False
    
    Next
' --------------------------------------------------------------------------------------------------
' Finish up  ---------------------------------------------------------------------------------------
    Sheets("Master Lists").Select
        Lock_Data
        Application.EnableEvents = True
        Application.Calculation = True
' --------------------------------------------------------------------------------------------------
End Sub


Ask: A dynamic loop to generate an array of relevent sheets with a fixed range

CodePudding user response：

After a lot of head scraching and trying numerous methods, I finally came up with this code

...
  Dim Nbr_Students As Integer
  Dim Counter As Integer
  Dim i As Integer
  Dim Student_Sheets As Variant

  Nbr_Students = Sheets("Master Lists").Range("M3").Value - 1
  Counter = 15
  i = 0

  ReDim RngArray(0 To Nbr_Students)
    Do While i <= Nbr_Students
        Set RngArray(i) = Worksheets(Counter).Range("C141:C157")
        Counter = Counter   1
        i = i   1
    Loop
...