使用 VBA 将过滤后的数据复制到另一个工作表

Question

I have two sheets. One has the complete data and the other is based on the filter applied on the first sheet.

Name of the data sheet : Data
Name of the filtered Sheet : Hoky

I am just taking a small portion of data for simplicity. MY objective is to copy the data from Data Sheet, based on the filter. I have a macro which somehow works but its hard-coded and is a recorded macro.

My problems are:

1. The number of rows is different everytime. (manual effort)
2. Columns are not in order.

Sub TESTTHIS()
'
' TESTTHIS Macro
'
'FILTER
Range("F2").Select
Selection.AutoFilter
ActiveSheet.Range("$B$2:$F$12").AutoFilter Field:=5, Criteria1:="hockey"

'Data Selection and Copy
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Hockey").Select
Range("E3").Select
ActiveSheet.Paste

Sheets("Data").Select
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hockey").Select
Range("D3").Select
ActiveSheet.Paste

Sheets("Data").Select
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hockey").Select
Range("C3").Select
ActiveSheet.Paste

End Sub

Answer 1

Best way of doing it

Below code is to copy the visible data in DBExtract sheet, and paste it into duplicateRecords sheet, with only filtered values. Range selected by me is the maximum range that can be occupied by my data. You can change it as per your need.

  Sub selectVisibleRange()

    Dim DbExtract, DuplicateRecords As Worksheet
    Set DbExtract = ThisWorkbook.Sheets("Export Worksheet")
    Set DuplicateRecords = ThisWorkbook.Sheets("DuplicateRecords")

    DbExtract.Range("A1:BF9999").SpecialCells(xlCellTypeVisible).Copy
    DuplicateRecords.Cells(1, 1).PasteSpecial


    End Sub

Answer 2

When i need to copy data from filtered table i use range.SpecialCells(xlCellTypeVisible).copy. Where the range is range of all data (without a filter).

Example:

Sub copy()
     'source worksheet
     dim ws as Worksheet
     set ws = Application.Worksheets("Data")' set you source worksheet here
     dim data_end_row_number as Integer
     data_end_row_number = ws.Range("B3").End(XlDown).Row.Number
    'enable filter
    ws.Range("B2:F2").AutoFilter Field:=2, Criteria1:="hockey", VisibleDropDown:=True
    ws.Range("B3:F" & data_end_row_number).SpecialCells(xlCellTypeVisible).Copy
    Application.Worksheets("Hoky").Range("B3").Paste
    'You have to add headers to Hoky worksheet
end sub

Answer 3

I suggest you do it a different way.

In the following code I set as a Range the column with the sports name F and loop through each cell of it, check if it is "hockey" and if yes I insert the values in the other sheet one by one, by using Offset .

I do not think it is very complicated and even if you are just learning VBA, you should probably be able to understand every step. Please let me know if you need some clarification

Sub TestThat()

'Declare the variables
Dim DataSh As Worksheet
Dim HokySh As Worksheet
Dim SportsRange As Range
Dim rCell As Range
Dim i As Long

'Set the variables
Set DataSh = ThisWorkbook.Sheets("Data")
Set HokySh = ThisWorkbook.Sheets("Hoky")

Set SportsRange = DataSh.Range(DataSh.Cells(3, 6), DataSh.Cells(Rows.Count, 6).End(xlUp))
    'I went from the cell row3/column6 (or F3) and go down until the last non empty cell

    i = 2

    For Each rCell In SportsRange 'loop through each cell in the range

        If rCell = "hockey" Then 'check if the cell is equal to "hockey"

            i = i + 1                                'Row number (+1 everytime I found another "hockey")
            HokySh.Cells(i, 2) = i - 2               'S No.
            HokySh.Cells(i, 3) = rCell.Offset(0, -1) 'School
            HokySh.Cells(i, 4) = rCell.Offset(0, -2) 'Background
            HokySh.Cells(i, 5) = rCell.Offset(0, -3) 'Age

        End If

    Next rCell

End Sub

Answer 4

it needs to be .Row.count not Row.Number?

That's what I used and it works fine Sub TransfersToCleared() Dim ws As Worksheet Dim LastRow As Long Set ws = Application.Worksheets("Export (2)") 'Data Source LastRow = Range("A" & Rows.Count).End(xlUp).Row ws.Range("A2:AB" & LastRow).SpecialCells(xlCellTypeVisible).Copy