Public Sub MergeToTable(SheetFrom As String, SheetTo As String, tableName As String, Optional ToColumnToUse, Optional FromRow, Optional SortColumn)
Dim tbl As ListObject
Dim NewRow As ListRow
If IsMissing(ToColumnToUse) Then
    ToColumnToUse = 1
End If
If IsEmpty(ToColumnToUse) Then
    InputStop = 0
    Do Until InputStop > 0
        Test = InputBox("Enter From Column To Use for Row Counter")
        If IsNumeric(Test) Then
            InputStop = Test
        End If
    Loop
    ToColumnToUse = InputStop
End If
If Not IsNumeric(ToColumnToUse) Then
    InputStop = 0
    Do Until InputStop > 0
        Test = InputBox("Enter From Column To Use for Row Counter")
        If IsNumeric(Test) Then
            InputStop = Test
        End If
    Loop
    ToColumnToUse = InputStop
End If
If IsMissing(FromRow) Then
    FromRow = 1
End If
If IsEmpty(FromRow) Then
    InputStop = 0
    Do Until InputStop > 0
        Test = InputBox("Enter From Row To Use for Column Counter")
        If IsNumeric(Test) Then
            InputStop = Test
        End If
    Loop
    FromRow = InputStop
End If
If Not IsNumeric(FromRow) Then
    InputStop = 0
    Do Until InputStop > 0
        Test = InputBox("Enter From Row To Use for Column Counter")
        If IsNumeric(Test) Then
            InputStop = Test
        End If
    Loop
    FromRow = InputStop
End If
Application.ScreenUpdating = False
MergeAreaColEnd = ThisWorkbook.Sheets(SheetFrom).UsedRange.Columns(ThisWorkbook.Sheets(SheetFrom).UsedRange.Columns.Count).Column
LongestColumn = ThisWorkbook.Sheets(SheetTo).UsedRange.Columns(ThisWorkbook.Sheets(SheetTo).UsedRange.Columns.Count).Column
If MergeAreaColEnd <> LongestColumn Then
    MsgBox "Column count mismatch. Call aborted", vbCritical, "Column Mismatch"
    Exit Sub
End If
LongestColumn = 0
For X = 1 To MergeAreaColEnd
    If ThisWorkbook.Sheets(SheetFrom).Cells(Rows.Count, X).End(xlUp).Row > LongestColumn Then
        LongestColumn = ThisWorkbook.Sheets(SheetFrom).Cells(Rows.Count, X).End(xlUp).Row
    End If
Next
MergeAreaRowEnd = LongestColumn
If TableExtant(tableName, SheetTo) Then
    ThisWorkbook.Sheets(SheetTo).ListObjects(tableName).Unlist
End If
For X = 1 To MergeAreaColEnd
    If ThisWorkbook.Sheets(SheetFrom).Cells(Rows.Count, X).End(xlUp).Row > LongestColumn Then
        LongestColumn = ThisWorkbook.Sheets(SheetFrom).Cells(Rows.Count, X).End(xlUp).Row
    End If
Next
ThisWorkbook.Sheets(SheetFrom).Range(Cells(FromRow, 1).Address(), Cells(LongestColumn, MergeAreaColEnd).Address()).Copy
TargetRow = ThisWorkbook.Sheets(SheetTo).Cells(Rows.Count, ToColumnToUse).End(xlUp).Row + 1
ThisWorkbook.Sheets(SheetTo).Cells(TargetRow, ToColumnToUse).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
ThisWorkbook.Sheets(SheetTo).Activate
TargetRow = ThisWorkbook.Sheets(SheetTo).Cells(Rows.Count, ToColumnToUse).End(xlUp).Row
ThisWorkbook.Sheets(SheetTo).ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(LongestColumn, MergeAreaColEnd)), , xlYes).name = tableName
Set tbl = ThisWorkbook.Sheets(SheetTo).ListObjects(tableName)
If Not IsMissing(SortColumn) Then
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range(SortColumn), SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
End If
Application.ScreenUpdating = True
End Sub