VBA Copy & Paste Creates over 2000 blank rows - Looking for options.

Good afternoon!

I have two spreadsheets (FakeEmployees, FakeTerms) where I am trying to remove employee absence data and employee records for employees that have been terminated from the FakeEmployees workbook to FakeTerms workbook. It is successful, and I am so thankful for the help here. I am looking for a way to combine the two separate macros so that it purges employee data first (Data Tab) then employee records (Employee Tab) from FakeEmployees to the same worksheets in FakeTerms. I'm also wanting to figure out why it is leaving thousands of blank rows before the data is populated on the FakeTerms workbook.

Any assistance is appreciated!

Term Data Macro:

Option Explicit

Sub TermData()
    Dim wb As Workbook, wb1 As Workbook
    Dim ws As Worksheet, ws1 As Worksheet
    Dim cel As Range
    Dim Lr As Long, LR1 As Long, cnt As Long
    Dim MyPath As String

    MyPath = ThisWorkbook.Path
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Data")

    With ws
        .Unprotect Password:="password"
        Lr = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
    End With

    With ws.ListObjects("Data")
        .Range.AutoFilter Field:=16, Criteria1:="<>"
        cnt = .AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If cnt >= 1 Then
            Application.Workbooks.Open (MyPath & "\" & "FakeTerms.xlsm")
            Set wb1 = ActiveWorkbook
            Set ws1 = wb1.Sheets("Data")

            With ws1
                LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
            End With
            For Each cel In .AutoFilter.Range.Offset(1, 0).Columns(16).SpecialCells(xlCellTypeVisible)
                If Not IsEmpty(cel.Value) Then
                    ws.Range(ws.Cells(cel.Row, "A"), ws.Cells(cel.Row, "P")).Copy
                    ws1.Range("A2" & LR1).PasteSpecial (xlPasteValues)
                    LR1 = LR1 + 1
                End If
            Next cel
        End If
        wb1.Close True
        Application.DisplayAlerts = False
        With ws
            .Range("A2:P" & Lr).SpecialCells(xlCellTypeVisible).Delete
        End With
        Application.DisplayAlerts = True
        .Range.AutoFilter Field:=16
    End With
End Sub

Term Employees Macro:

Option Explicit

Sub TermEmps()
    Dim wb As Workbook, wb1 As Workbook
    Dim ws As Worksheet, ws2 As Worksheet
    Dim cel As Range
    Dim Lr As Long, LR1 As Long, cnt As Long
    Dim MyPath As String

    MyPath = ThisWorkbook.Path
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Employees")

    With ws
        .Unprotect Password:="password"
        Lr = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
    End With

    With ws.ListObjects("Employees")
        .Range.AutoFilter Field:=6, Criteria1:="<>"
        cnt = .AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If cnt >= 1 Then
            Application.Workbooks.Open (MyPath & "\" & "FakeTerms.xlsm")
            Set wb1 = ActiveWorkbook
            Set ws2 = wb1.Sheets("Employees")

            With ws2
                LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
            End With
            For Each cel In .AutoFilter.Range.Offset(1, 0).Columns(9).SpecialCells(xlCellTypeVisible)
                If Not IsEmpty(cel.Value) Then
                    ws.Range(ws.Cells(cel.Row, "A"), ws.Cells(cel.Row, "I")).Copy
                    ws2.Range("A2" & LR1).PasteSpecial (xlPasteValues)
                    LR1 = LR1 + 1
                End If
            Next cel
        End If
        wb1.Close True
        Application.DisplayAlerts = False
        With ws
            .Range("A2:I" & Lr).SpecialCells(xlCellTypeVisible).Delete
        End With
        Application.DisplayAlerts = True
        .Range.AutoFilter Field:=6
    End With
End Sub

FakeTerms.zip