VBA - Paste Data AS a table

[Abgar]

Hi all,

Im using the below macro to copy filtered data from a table on one worksheet, and paste it on a new worksheet, below the last used row.
This all works perfectly fine and as expected, but ideally i want the PASTED data (on Sheet4) to be pasted as a table.
Is this possible and easy to implement?

**Also, i'm assuming the below code isn't the most efficient, as i have adapted from several sources to make it do what i want. If there's a cleaner way of writing, that'd be great to know too.

Cheers

Sub PasteData()

    Dim ws As Worksheet
    Dim rng As Range
    Dim rng2 As Range
    Dim FilteredData As ListObject
    Worksheets("Sheet4").Select   
    
    Worksheets("Sheet1").Select
    Worksheets("Sheet1").Range("A1").Select
    
    Set FilteredData = ActiveSheet.ListObjects(1)
    
    With FilteredData.AutoFilter.Range
     On Error Resume Next  'are these needed?  There will always be data to copy
       Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
     On Error GoTo 0 'are these needed?  There will always be data to copy
    End With
    If rng2 Is Nothing Then
       MsgBox "No data to copy"
    Else
       Set ws = Sheets("Sheet4")
       Set rng = FilteredData.AutoFilter.Range
       'rng.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A1") ' Paste data in A1
       rng.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Cells(1).End(xlDown).Offset(3, 0)  ' Paste Data 3 rows below last used cell in column A
    End If

End Sub

 

[Yongle]

i want the PASTED data (on Sheet4) to be pasted as a table

Try adding this at the bottom of your code

    Dim tbl As ListObject, rng As Range
    Set rng = ws.Range("A" & Rows.Count).End(xlUp).CurrentRegion
    Set tbl = ws.ListObjects.Add(xlSrcRange, rng, xlYes)

 

[Abgar]

Try adding this at the bottom of your code

    Dim tbl As ListObject, rng As Range
    Set rng = ws.Range("A" & Rows.Count).End(xlUp).CurrentRegion
    Set tbl = ws.ListObjects.Add(xlSrcRange, rng, xlYes)

That is absolutely perfect. Thank you so much for your help Yongle