Sub TestIfActiveCellIsInTable()
    Dim ActiveCellInTable As Boolean
    Dim ACell As Range

    'Set a reference to the ActiveCell named ACell. You can always use
    'ACell now to point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test whether ACell is in a table.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    If ActiveCellInTable = True Then
        MsgBox "The ActiveCell is a part of a table."
    Else
        MsgBox "The ActiveCell is not a part of a table."
    End If
End Sub

ACell.ListObject.Range

ACell.ListObject.DataBodyRange

Sub CopyListOrTable2NewWorksheet()
'Works in Excel 2003 and Excel 2007. Only copies visible data.
    Dim New_Ws As Worksheet
    Dim ACell As Range
    Dim CCount As Long
    Dim ActiveCellInTable As Boolean
    Dim CopyFormats As Variant
    Dim sheetName As String

    'Check to see if the worksheet or workbook is protected.
    If ActiveWorkbook.ProtectStructure = True Or ActiveSheet.ProtectContents = True Then
        MsgBox "This macro will not work when the workbook or worksheet is write-protected."
        Exit Sub
    End If

    'Set a reference to the ActiveCell. You can always use ACell to
    'point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'do not need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'If the cell is in a list or table run the code.
    If ActiveCellInTable = True Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        'Test if there are more than 8192 separate areas. Excel only supports
        'a maximum of 8,192 non-contiguous areas through VBA macros and manual.
        On Error Resume Next
        With ACell.ListObject.ListColumns(1).Range
            CCount = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
        End With
        On Error GoTo 0

        If CCount = 0 Then
            MsgBox "There are more than 8192 areas, so it is not possible to " & _
                   "copy the visible data to a new worksheet. Tip: Sort your " & _
                   "data before you apply the filter and try this macro again.", _
                   vbOKOnly, "Copy to new worksheet"
        Else
            'Copy the visible cells.
            ACell.ListObject.Range.Copy

            'Add a new Worksheet.
            Set New_Ws = Worksheets.Add(after:=Sheets(ActiveSheet.Index))

            'Prompt the user for the worksheet name.
            sheetName = InputBox("What is the name of the new worksheet?", _
                                 "Name the New Sheet")

            On Error Resume Next
            New_Ws.Name = sheetName
            If Err.Number > 0 Then
                MsgBox "Change the name of sheet : " & New_Ws.Name & _
                     " manually after the macro is ready. The sheet name" & _
                     " you typed in already exists or you use characters" & _
                     " that are not allowed in a sheet name."
                Err.Clear
            End If
            On Error GoTo 0

            'Paste the data into the new worksheet.
            With New_Ws.Range("A1")
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteValuesAndNumberFormats
                .Select
                Application.CutCopyMode = False
            End With

            'Call the Create List or Table dialog.
            Application.ScreenUpdating = True
            Application.CommandBars.FindControl(ID:=7193).Execute
            New_Ws.Range("A1").Select

            ActiveCellInTable = False
            On Error Resume Next
            ActiveCellInTable = (New_Ws.Range("A1").ListObject.Name <> "")
            On Error GoTo 0

            Application.ScreenUpdating = False

            'If you do not create a table, you have the option to copy the formats.
            If ActiveCellInTable = False Then
                Application.GoTo ACell
                CopyFormats = MsgBox("Do you also want to copy the Formats?", _
                                     vbOKCancel + vbExclamation, "Copy to new worksheet")
                If CopyFormats = vbOK Then
                    ACell.ListObject.Range.Copy
                    With New_Ws.Range("A1")
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
                End If
            End If
        End If

        'Select the new worksheet if it is not active.
        Application.GoTo New_Ws.Range("A1")

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With

    Else
        MsgBox "Select a cell in your list or table before you run the macro.", _
               vbOKOnly, "Copy to new worksheet"
    End If
End Sub