This is my code to break up a data base in a source file and then create sub files for every member listed in the database. I'm having a hard time figuring out how to include a copy of 3 additional sheets("Program", "Banked", "Drive") from the source file in each of the sub files.

Option Explicit
Sub Demo()
    Dim i As Long, j As Long, sPath As String, lastRow As Range
    Dim rowCnt As Long, ColCnt As Long, rngData As Range
    Dim arrData, arrRow, oSht As Worksheet, oWK As Workbook
    Const START_ROW = 8
    Const MTH_DIR = "202406"
    sPath = ThisWorkbook.Path & "\" & MTH_DIR
    If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    Set oSht = ThisWorkbook.Sheets("Sheet1") ' ActiveSheet
    Set rngData = oSht.Range("A1").CurrentRegion
    rowCnt = rngData.Rows.Count
    ColCnt = rngData.Columns.Count
    arrData = rngData.Value
    oSht.Copy
    Set oWK = ActiveWorkbook
    With oWK.Sheets(1)
        Set lastRow = .Cells(START_ROW, 1).Resize(, ColCnt)
        .Rows(START_ROW + 1 & ":" & rowCnt).Delete
        With lastRow.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
    End With
    ReDim arrRes(0, 1 To ColCnt)
    For i = START_ROW To rowCnt
        If Len(arrData(i, 1)) > 0 Then
            If i > START_ROW Then
                For j = 1 To ColCnt
                    arrRes(0, j) = arrData(i, j)
                Next
                lastRow.Value = arrRes
            End If
            oWK.SaveAs sPath & arrData(i, 1) & ".xlsx"
        End If
    Next
    oWK.Close False
End Sub