Sub create_personal_schedule()

Dim src_row As Integer
Dim c As Long

Dim empArr(1 To 7) As String
empArr(1) = "Alex"
empArr(2) = "Douglas"
empArr(3) = "Irena"
empArr(4) = "Iris"
empArr(5) = "Max"
empArr(6) = "Mike"
empArr(7) = "Edward"


src_row = 1
tgt_row = 1

' Select the last worksheet to ensure personal schedules are added to the end
Worksheets(Worksheets.Count).Activate

For empCount = 1 To UBound(empArr)

    ' Delete spreadsheet if exists
    ' http://www.ozgrid.com/forum/showthread.php?t=69609
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets(empArr(empCount)).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    ' Create spreadsheet
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = empArr(empCount)
    
    
        Do While src_row < 600
        
            ' Get day of week row
            If Worksheets("2016").Cells(src_row, 2).Text = "Mon" Then
            
                ' Leave an empty row before each header
                ' Do not do it for the first row
                If src_row <> 3 Then
                    tgt_row = tgt_row + 1
                End If
        
                ' Copy Date header
                Worksheets("2016").Range("B" & src_row & ":H" & src_row + 1).Copy
                With Worksheets(empArr(empCount)).Range("A" & tgt_row & ":G" & tgt_row + 1)
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial Paste:=xlValues
                End With
                
                ' Copy Notes header (Done separately because of merged cells)
                Worksheets("2016").Range("I" & src_row & ":J" & src_row + 1).Copy
                With Worksheets(empArr(empCount)).Range("H" & tgt_row & ":I" & tgt_row + 1)
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial Paste:=xlValues
                End With
                
                ' Header is 2 rows high
                tgt_row = tgt_row + 2
            End If
            
            ' Get Employee row and copy
            If Worksheets("2016").Cells(src_row, 1).Text = empArr(empCount) Then
                Worksheets("2016").Range("B" & src_row & ":H" & src_row).Copy
                With Worksheets(empArr(empCount)).Range("A" & tgt_row & ":G" & tgt_row)
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial Paste:=xlValues
                End With
                
                ' Copy Notes section (Done separately because of merged cells)
                Worksheets("2016").Range("I" & src_row & ":J" & src_row).Copy
                With Worksheets(empArr(empCount)).Range("H" & tgt_row & ":I" & tgt_row)
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial Paste:=xlValues
                End With
                
                tgt_row = tgt_row + 1
            End If
            
        
            
            
            src_row = src_row + 1
        Loop
      
    ' Reset pointer back to 1 for the next employee schedule
    src_row = 1
    tgt_row = 1
Next empCount

End Sub