Looking for the best way to update different worksheets within the same workbook(template). I have a workbook that will contain 4 worksheets, I will need to update the data from an Access Database. My current vba (Access) will take the template and add a new workbook for each instances within the loop. I need to be able to check if there is more than 1 instance of the loop and if so, create the first copy of the template then update all pertinent worksheets within the newly created workbook.

Private Sub cmdExportToExcel_Click()
On Error GoTo ProcError

'For Late Binding
'   Dim xlApp As Object
  
'For Early Binding
    Dim xlApp As Excel.Application
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strDataArray() As String
    Dim strSQL As String
    Dim strFolder As String
    Dim strFileName As String
    Dim i As Integer, j As Integer, intRecordCount As Integer
    Dim blnSuccess As Boolean
    Dim gWkSht As String
    Dim nRow As Integer
   
    Set db = CurrentDb()
    
    StatusMsg Me, ""
    
    strFolder = GetUsersDesktopFolder
    strFileName = strFolder & "2010 FTI-ME Ent-DP.xls"
   
    strSQL = "SELECT Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1) AS CourseTitle," & _
                " TL_CourseList.[Ilp Learning **] AS CourseNumber, TL_CourseList.[Delv Mthd Tot Hrs] AS Duration," & _
                " TL_SourceTraining.TrainSource AS CourseSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " FROM TL_SourceTraining INNER JOIN (TL_CourseList LEFT JOIN TL_CourseFreq ON" & _
                " TL_CourseList.Frequency = TL_CourseFreq.FreqRecID) ON TL_SourceTraining.SourceRecID = TL_CourseList.SourceRecID" & _
            " WHERE (((TL_CourseList.OnXLS) <> 0) And ((TL_CourseList.InActive) = 0))" & _
            " GROUP BY Mid([Ilp Learning Title],1,InStrRev([Ilp Learning Title],'(')-1), TL_CourseList.[Ilp Learning **]," & _
                " TL_CourseList.[Delv Mthd Tot Hrs], TL_SourceTraining.TrainSource, TL_CourseList.StandardRequiredDt," & _
                " TL_CourseFreq.[Frequency Required]" & _
            " ORDER BY TL_CourseList.[Ilp Learning **]"

   Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
   
   If rs.RecordCount = 0 Then
      MsgBox "There Are No Records to Export for the Courses Selected.", vbInformation, "No Data To Export..."
      GoTo ExitProc
   Else
      rs.MoveLast: rs.MoveFirst 'Required to get an accurate count of records.
      intRecordCount = rs.RecordCount
   End If
   
   If Dir(strFileName) <> "" Then
      Kill (strFileName)
   End If
   'Sets name of Excel worksheet within the Workbook based on above mentioned Template -
   'to be updated based on Unit Chief Name selected form list box
   strSQL1 = "Select WkshtName from qryUnitChief Where BEMS IN(" & MyString & ")"
   Set rs1 = db.OpenRecordset(strSQL1, dbOpenSnapshot)
    Do Until rs1.EOF
        gWkSht = rs1.Fields("WkshtName").value
        GoSub SubExport
    Loop
    GoTo ExitProc:
SubExport:
    Set xlApp = CreateObject("Excel.Application")
      With xlApp
         .Workbooks.Open CurrentProject.path & "\2010 FTI-ME Ent-DP.xlt"
         .Worksheets(gWkSht).Activate
         
         'Copy course name and course number data, starting at cell F10 = Row 10, Column 6
         i = 6
         Do While Not rs.EOF
            .ActiveSheet.Cells(6, 2).value = Date   'Date Report Ran
            .ActiveSheet.Cells(6, i).value = rs!StandardRequiredDt 'Course duration
            .ActiveSheet.Cells(7, i).value = rs!Duration
            .ActiveSheet.Cells(8, i).value = rs!CourseSource
            .ActiveSheet.Cells(9, i).value = Trim(rs!CourseTitle)
            .ActiveSheet.Cells(10, i).value = rs!CourseNumber
            i = i + 1
            rs.MoveNext
         Loop
     
         'Copy detail data, starting at cell A13
         strSQL = "SELECT * FROM zTempData ORDER BY EmployeeName"
         Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
            .Range("A11").CopyFromRecordset rs
            .Visible = True
            .ActiveWorkbook.SaveAs strFileName
         blnSuccess = True
      End With

   If blnSuccess = True Then
      StatusMsg Me, Mid(strFileName, Len(strFolder) + 1) & " report has been saved to your Desktop folder.", vbBlue
   End If
Return
      
ExitProc:
'Cleanup
   If Not rs Is Nothing Then
      rs.Close: Set rs = Nothing
   End If
   If Not rs1 Is Nothing Then
      rs1.Close: Set rs1 = Nothing
   End If
   Set db = Nothing
   Exit Sub
ProcError:
   Select Case Err.Number
      Case 70
         MsgBox "You Must Close the FTI-ME Ent-DP.xls File" & vbCrLf _
              & "Before Attempting to Run This Function.", vbCritical, "Cannot Delete Open File..."
      Case Else
         MsgBox "Error " & Err.Number & ": " & Err.Description, _
                vbCritical, "Error in procedure cmdExportToExcel_Click..."
   End Select
   Resume ExitProc
   Resume
End Sub