Auto populate timecards.

[Ajax01]

With a lot of searching I found a couple codes that help me get close to what I want...close but would like to see if I can make it perfect. Using excel 2010 I have a workbook with the following tabs, Employees, Aide Mileage, and TimeCard. When I run the following code it creates a tab/timecard for each employee as they are added:

Sub CreateSheetsFromAList()
    Dim nameSource      As String 'sheet name where to read names
    Dim nameColumn      As String 'column where the names are located
    Dim nameStartRow    As Long   'row from where name starts
     
    Dim trainingSheet   As String 'training material sheet name
    Dim trainingRange   As String 'range to copy from training material sheet
     
    Dim nameEndRow      As Long   'row where name ends
    Dim employeeName    As String 'employee name
     
    Dim newSheet        As Worksheet
     
    nameSource = "Employees"
    nameColumn = "A"
    nameStartRow = 2
     
    trainingSheet = "TimeCard"
    trainingRange = "A1:M38" 'for example this is range we are going to copy
     
    'find the last cell in use
    nameEndRow = Sheets(nameSource).Cells(Rows.Count, nameColumn).End(xlUp).Row
     
    'loop till last row
    Do While (nameStartRow <= nameEndRow)
        'get the name
        employeeName = Sheets(nameSource).Cells(nameStartRow, nameColumn)
         
        'remove any white space
        employeeName = Trim(employeeName)
         
        ' if name is not equal to ""
        If (employeeName <> vbNullString) Then
             
            On Error Resume Next 'do not throw error
            Err.Clear 'clear any existing error
             
            'if sheet name is not present this will cause error that we are going to leverage
            Sheets(employeeName).Name = employeeName
             
            If (Err.Number > 0) Then
                'sheet was not there, so it create error, so we can create this sheet
                Err.Clear
                On Error GoTo -1 'disable exception so to reuse in loop
                 
                'add new sheet
                Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
                 
                'rename sheet
                newSheet.Name = employeeName
            
                Application.CutCopyMode = False 'clear clipboard
                'copy training material
                Sheets(trainingSheet).Range(trainingRange).Copy
                 
                'paste training material
                Sheets(employeeName).Cells(1, "A").PasteSpecial
                Application.CutCopyMode = False
                Range("C1").Value = employeeName
                ActiveSheet.Protect DrawingObjects:=True, _
                Contents:=True, Scenarios:=True, Password:="password"
               ' Reprotect the Sheet
            End If
        End If
        nameStartRow = nameStartRow + 1 'increment row
    Loop
End Sub

What I would like to do as well is add the new names it creates plus the column next to that name in the "Employees" tab (employee #) into the "Aide Mileage" tab starting at B2 going down the next empty cell that is available.