Code Check

[Miya]

Hi the below code is used to copy filtered data to sheet data, the code works as required but the only issue is that I want the headers which are in row 6 to also copied to sheet Data, how can i do this?

Sub CopyFilter()

Dim rng As Range
Dim rng2 As Range
 
With ActiveSheet.Range("A6")
    .AutoFilter Field:=2, Criteria1:="JP"
End With
 
With ActiveSheet.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "No data to copy"
Else
   Set rng = ActiveSheet.AutoFilter.Range
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
     Destination:=Worksheets("Data").Range("A7")
End If
   ActiveSheet.ShowAllData
   

End Sub

 

[Robert E Lee]

Try

Range("A6").EntireRow.Copy Destination:=Sheets("Data").Range("A1")

Hope that helps

Robert

 

[tusharm]

Untested. Replace

   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
     Destination:=Worksheets("Data").Range("A7")

with

   rng.Resize(rng.Rows.Count).Copy _
     Destination:=Worksheets("Data").Range("A7")

Hi the below code is used to copy filtered data to sheet data, the code works as required but the only issue is that I want the headers which are in row 6 to also copied to sheet Data, how can i do this?

Sub CopyFilter()

Dim rng As Range
Dim rng2 As Range
 
With ActiveSheet.Range("A6")
    .AutoFilter Field:=2, Criteria1:="JP"
End With
 
With ActiveSheet.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "No data to copy"
Else
   Set rng = ActiveSheet.AutoFilter.Range
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
     Destination:=Worksheets("Data").Range("A7")
End If
   ActiveSheet.ShowAllData
   

End Sub