none
Copy and paste data with 2 activeFilter fields and 2 criteria RRS feed

  • Question

  • Hi,

    I have a huge data sheet. 

    I want to copy some of the data to a new sheet, see code below:

    Sub DataSheetTest() Dim ShapePP As Object Set WB = Workbooks(1) Set WS1 = WB.Worksheets(1) Set WS4 = WB.Worksheets(4) ATARankOne = WS1.Cells(3, 5) ATARankTwo = WS1.Cells(4, 5) ATARankThree = WS1.Cells(5, 5) ATARankFour = WS1.Cells(6, 5) ATARankFive = WS1.Cells(7, 5) ATARankSix = WS1.Cells(8, 5) ATARankSeven = WS1.Cells(9, 5) ATARankEight = WS1.Cells(10, 5) ATARankNine = WS1.Cells(11, 5) ATARankTen = WS1.Cells(12, 5) 'Create new workbook and add sheets with specific names (the names of the Top 10 ranking). 'Sheet 1, 2 and 3 are already addded, so these I have to use. Set NewBook = Workbooks.Add With NewBook .Title = "73N TSID " & WS4.Cells(2, 11) & " Top 10" .Subject = "Sales" .Sheets(1).Name = ATARankTen .Worksheets.Add().Name = ATARankNine .Worksheets.Add().Name = ATARankEight .Worksheets.Add().Name = ATARankSeven .Worksheets.Add().Name = ATARankSix .Worksheets.Add().Name = ATARankFive .Worksheets.Add().Name = ATARankFour .Worksheets.Add().Name = ATARankThree .Worksheets.Add().Name = ATARankTwo .Worksheets.Add().Name = ATARankOne .Worksheets.Add().Name = "Top 10" '.SaveAs Filename:="Allsales.xls" End With 'Top 10 Sheet ThisWorkbook.Worksheets("73N Index").Range("C1:AA12").Copy NewBook.Sheets("Top 10").Paste Destination:=Sheets("Top 10").Rows(2).Columns(1) Set NewBookTopTen = NewBook.Sheets("Top 10") With NewBookTopTen .Cells(1, 1).Value = "Top 10 TSID " & WS4.Cells(2, 11) .Cells(1, 1).Font.Bold = True 'Columns .Columns("A").ColumnWidth = 9 .Columns("B").ColumnWidth = 9 .Columns("C").ColumnWidth = 9 .Columns("D").ColumnWidth = 30 .Columns("O").ColumnWidth = 14 .Range("D2:D13").WrapText = True 'Rows .Rows(1).RowHeight = 15 .Rows(2).RowHeight = 15 .Rows(3).RowHeight = 15 .Rows(4).RowHeight = 15 .Rows(5).RowHeight = 15 .Rows(6).RowHeight = 15 .Rows(7).RowHeight = 15 .Rows(8).RowHeight = 15 .Rows(9).RowHeight = 15 .Rows(10).RowHeight = 15 .Rows(11).RowHeight = 15 .Rows(12).RowHeight = 15 .Rows(13).RowHeight = 15 End With '=============================================================================================================================== 'ATA Rank 1 ThisWorkbook.Worksheets("73N Index").Range("C1:AA3").Copy NewBook.Sheets(ATARankOne).Paste Destination:=Sheets(ATARankOne).Rows(2).Columns(1) Set NewBookRankOne = NewBook.Sheets(ATARankOne) With NewBookRankOne .Cells(1, 1).Value = "Top 10 TSID " & WS4.Cells(2, 11) .Cells(1, 1).Font.Bold = True 'Columns .Columns("A").ColumnWidth = 9 .Columns("B").ColumnWidth = 9 .Columns("C").ColumnWidth = 9 .Columns("D").ColumnWidth = 30 .Columns("O").ColumnWidth = 14 .Range("D2:D13").WrapText = True 'Rows .Rows(1).RowHeight = 15 .Rows(2).RowHeight = 15 .Rows(3).RowHeight = 15 'Delays, Cancellations, D&C Costs and AOS/ODI .Cells(6, 1).Value = "Delays, Cancellations, D&C Costs and AOS/ODI" .Cells(6, 1).Font.Bold = True End With EDate = WS4.Cells(3, 8) ThisWorkbook.Worksheets("TSID Delay Data").Range("A:W").AutoFilter Field:=23, Criteria1:=">=" & EDate ThisWorkbook.Worksheets("TSID Delay Data").Range("A:W").AutoFilter Field:=7, Criteria1:=ATARankOne End Sub


    Now I have 2 criteria and 2 fields that AutoFilter uses. Excel has to filter the data first and then copy this data to a new sheet.

    Problem is, how can I program that Excel will use both filters before copying and paste the data?

    I hope someone can help me.

    Thanks!


    Tuesday, October 25, 2016 9:30 AM

Answers

  • The filter will show only the row where both 23rd Column and 7th column criteria satisfied.The filter is OK.

    To copy you can use like below

    ThisWorkbook.Worksheets("TSID Delay Data").AutoFilter.range.copy -------

    Give destination address at -----


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    • Marked as answer by ganeshgebhard Tuesday, October 25, 2016 2:36 PM
    Tuesday, October 25, 2016 2:05 PM
    Answerer