Sub Format_Sheet1()
Dim i As Long, lastRow As Long
Dim wks As Worksheet
Dim deleteRow As Boolean, allDeleted As Boolean
Dim tmp As String
'Discard blank rows and rows that start with "Created:" or "(p." in column A
'With rows that remain, insert 2 blank rows after each row that has a value in column A

    Set wks = Sheets("Sheet1")
       
    Application.ScreenUpdating = False
    lastRow = Range("A65536").End(xlUp).Row
    
    With Sheets(wks.Name)
        'stop deleting rows after cell with "(The End)" reached
        .Cells((lastRow + 1), 1).Value = "(The End)"
        
        'do the deletes
        For i = 1 To lastRow
            deleteRow = False
            tmp = Trim(.Cells(i, 1).Value)
            If tmp = "" Then
                deleteRow = True
            ElseIf Left(tmp, 8) = "Created:" Then
                deleteRow = True
            ElseIf tmp = "(The End)" Then
                deleteRow = True
                allDeleted = True
            Else
                If Left(tmp, 3) = "(p." Then
                    deleteRow = True
                End If
            End If
            If deleteRow Then
                .Cells(i, 1).EntireRow.Delete
                i = i - 1
            End If
            If allDeleted Then Exit For
        Next
        
        'do the inserts
        i = 1
        Do While .Cells((i + 1), 1).Value <> ""
            Rows((i + 1) & ":" & (i + 2)).Select
            Selection.Insert Shift:=xlDown
            i = i + 3
        Loop
        Range("A1").Select
    End With
    
    Application.ScreenUpdating = True
    
    Set wks = Nothing
    
End Sub