Create worksheet based on a template from a datasheet

Hi,
I have a datasheet and a template. I need to create around 30 worksheets(in the same workbook) using the data . When I run the macro with 7 sets of data it is working fine (execution time: 3 minutes). But it is hanging if I enter more number of data.

Please find the code I am using:

Option Explicit


Sub PTOTemplateFill()


Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String


Application.ScreenUpdating = False  'speed up macro execution
Application.DisplayAlerts = False   'no alerts, default answers used



Set dSht = Sheets("Datasheet")           'sheet with data on it starting in row2
Set tSht = Sheets("Project Page Template")       'sheet to copy and fill out

'Option to create separate workbooks
    MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
        "YES = template will be copied to separate workbooks." & vbLf & _
        "NO = template will be copied to sheets within this same workbook", _
            vbYesNo + vbQuestion) = vbYes

If MakeBooks Then   'select a folder for the new workbooks
    MsgBox "Please select a destination for the new workbooks"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then    'a folder was chosen
                SavePath = .SelectedItems(1) & "\"
                Exit Do
            Else                                'a folder was not chosen
                If MsgBox("Do you wish to abort?", _
                    vbYesNo + vbQuestion) = vbYes Then Exit Sub
            End If
        End With
    Loop
End If

'Determine last row of data then loop through the rows one at a time
    LastRw = dSht.Range("P" & Rows.Count).End(xlUp).Row
   
    For Rw = 2 To LastRw
        tSht.Copy After:=Worksheets(Worksheets.Count)   'copy the template
        With ActiveSheet                                'fill out the form
           
            .Name = dSht.Range("P" & Rw)
            .Range("AU1").Value = dSht.Range("P" & Rw).Value
           
            'Physical Progress
            .Range("L61:P61").Value = dSht.Range("AG" & Rw).Value
            .Range("L62:P62").Value = dSht.Range("AH" & Rw).Value
           
            'Financial Progress
            .Range("L66:P66").Value = dSht.Range("AD" & Rw).Value
            .Range("L67:P67").Value = dSht.Range("AC" & Rw).Value
           
            'Contract Status
            .Range("AC60:AG60").Value = dSht.Range("W" & Rw).Value
            .Range("AC62:AG62").Value = dSht.Range("Y" & Rw).Value
            .Range("AC63:AG63").Value = dSht.Range("AK" & Rw).Value
            .Range("AC64:AG64").Value = dSht.Range("AL" & Rw).Value
           
            'Contract No
            .Range("AC66:AG66").Value = dSht.Range("O" & Rw).Value
           
            'Title
            .Range("CI12").Value = dSht.Range("P" & Rw).Value
            .Range("CI13").Value = dSht.Range("Q" & Rw).Value
           
            'Summary
            .Range("L22:Z38").Value = dSht.Range("BL" & Rw).Value
            .Range("L41:Z57").Value = dSht.Range("BM" & Rw).Value
            .Range("AD23:AN31").Value = dSht.Range("BN" & Rw).Value
            .Range("AD49:AN57").Value = dSht.Range("BO" & Rw).Value
        End With
       
        If MakeBooks Then       'if making separate workbooks from filled out form
            ActiveSheet.Move
            ActiveWorkbook.SaveAs SavePath & Range("AU1").Value, xlNormal
            ActiveWorkbook.Close False
        End If
        Cnt = Cnt + 1
    Next Rw

    dSht.Activate
    If MakeBooks Then
        MsgBox "Workbooks created: " & Cnt
    Else
        MsgBox "Worksheets created: " & Cnt
    End If
   
Application.ScreenUpdating = True

End Sub

------------------------------------------------

Regards,
Viv