Copy all visible cells from an active worksheet to a new worksheet

This is only the lower part of a code where it filters out necessary data.

I am looking for a way to paste all data (including the header, if possible?) visible in the sheet.

This is what I have mustered up for now. I think my usage of 'UsedRange' might be wrong. I'm also trying to look into 'Selection.PasteSpecial'. Any ideas?

    Dim sourceWS As Worksheet
    Dim resultWS As Worksheet
    
    Set sourceWS = ActiveWorkbook.ActiveSheet
    Set resultWS = Worksheets.Add(After:=Sheets(Sheets.Count))
    
    On Error GoTo Err_Execute

    sourceWS.UsedRange.Copy
    resultWS.Range("A1").Rows("1:1").Insert Shift:=xlDown

Err_Execute:

    If Err.Number = 0 Then

        MsgBox "All have been copied!"

    ElseIf Err.Number <> 0 Then

        MsgBox Err.Description

    End If
    
    resultWS.Name = "RR案件Filterデータ"
    
    Application.ScreenUpdating = True

P.S. I have added a small bit to keep my brain moving, but I'm not so sure if I'm doing the right thing.

    Set columnEnd = sourceWS.Cells.Find(What:="*", After:=sourceWS.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    
    lastColumn = columnEnd.Columns.Count
    
    sourceWS.Range("A1", Cells(lastRow, lastColumn)).Copy

Solution

I think you are almost there, just use .SpecialCells(xlCellTypeVisible) to copy only visible cells:

Sub CopyVisibleDataToNewWorksheet()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rngVisible As Range
    Dim lngLastRow As Long
    Dim lngLastCol As Long

    ' Turn off screen updating and events for performance
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo ErrorHandler

    ' Set source worksheet as the active sheet
    Set wsSource = ActiveWorkbook.ActiveSheet

    ' Add a new worksheet at the end
    Set wsTarget = Worksheets.Add(After:=Sheets(Sheets.Count))
    wsTarget.Name = "New sheet"

    ' Find last row and column with data
    With wsSource
        lngLastRow = .Cells.Find(What:="*", _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row

        lngLastCol = .Cells.Find(What:="*", _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column

        ' Define the visible range including headers
        Set rngVisible = .Range("A1", .Cells(lngLastRow, lngLastCol)).SpecialCells(xlCellTypeVisible)

        ' Copy visible cells to target worksheet
        rngVisible.Copy Destination:=wsTarget.Range("A1")
    End With

    MsgBox "Visible data copied successfully!", vbInformation

Cleanup:
    ' Restore application settings
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
    Resume Cleanup
End Sub