Filtering and copying a sheet to another sheet... not working as planned!

[Jed Shields]

Morning all,

I'm trying to filter a sheet and then copy the filtered data to another sheet. What I've got below works but it balloons the size of the workbook up to 180Mb! I'm assuming it's because I'm copying the entire columns rather than just the filtered data...?

Any thoughts on a better approach?

Sub CopyTIData()

Dim LastRow As Long

 LastRow = Range("AJ" & Rows.Count).End(xlUp).Row

    ActiveSheet.Range("A1:BI" & LastRow).AutoFilter Field:=37, Criteria1:= _
        "T&I IT"


    Range("A:BI").Select
    
    Selection.Copy
    
    Sheets("T&I Data").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
 Sheets("Sheet1").Select
 
 ActiveSheet.ShowAllData
        
End Sub

Cheers,

Jed

 

[vcoolio]

Hello Jed,

Try the code amended as follows:-

Sub CopyTIData()

        Dim ws As Worksheet, sh As Worksheet
        Set ws = ActiveSheet
        Set sh = Sheets("T&I Data")
        
Application.ScreenUpdating = False

With ws.[A1].CurrentRegion
       .AutoFilter 37, "T&I IT"
       .Offset(1).EntireRow.Copy
       sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
       .AutoFilter
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
        
End Sub

Test it in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.

 

[nikio8]

After filter you can try simple

#
Sheets(?).Cells.Copy
or
Sheets(?).Cells(1,1).CurrentRegion.Copy

Sheets("T&I Data").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
#

PS you have paste twice in your code

 

[Jed Shields]

Perfect! I'd managed to get my version working better, but it was still adding another 10Mb to the workbook, so obviously copying additional rows as well.

Quick question... how do I modify the code to filter 2 columns? I'm copying the code for another sheet that also needs column 57 as "Vacant".

Cheers

Jed

 

[nikio8]

Sheets(?).Columns("A:B").AutoFilter

You could try index column, then "hide" based on condition, and "copy visible only"

You may have one cell or one format somewhere, that is why when you copy it is copying 1,000,000 rows...

 

[Jed Shields]

Nikio8, your reply came in the same time as I was replying to vcooli. I haven't taken a look at your suggestions yet...

Vcoolio - how do I change your code from one filter to two filters?

Hello Jed,

Try the code amended as follows:-

Sub CopyTIData()

        Dim ws As Worksheet, sh As Worksheet
        Set ws = ActiveSheet
        Set sh = Sheets("T&I Data")
        
Application.ScreenUpdating = False

With ws.[A1].CurrentRegion
       .AutoFilter 37, "T&I IT"
       .Offset(1).EntireRow.Copy
       sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
       .AutoFilter
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
        
End Sub

Test it in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.

 

[Fluff]

Try adding this line

With Ws.[a1].CurrentRegion
       .AutoFilter 37, "T&I IT"
      [COLOR=#ff0000] .AutoFilter 57, "vacant"[/COLOR]
       .Offset(1).EntireRow.Copy
       sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
       .AutoFilter
End With

 

[Jed Shields]

Yep, just got it to work, along with filtering everything except T&I IT

With ws.[A1].CurrentRegion
       .AutoFilter 37, "<>T&I IT"
       .AutoFilter 57, "Vacant"
       .Offset(0).EntireRow.Copy
       sh.Range("A" & Rows.Count).End(3)(1).PasteSpecial xlPasteAll
       .AutoFilter
End With

 

[vcoolio]

Hello Jed,

I'm glad that its working for you but I don't follow. In Column 37, you now want to filter everything that is not equal to "T & I IT"?

If you want to keep your file to around the same size after each transfer, you may want to look at deleting the filtered rows from the active sheet once each transfer is completed.

@ Fluff:
Thanks for dropping in that extra line of code in post #7 . I would have been fast asleep when you did that!

Cheerio.
vcoolio.

 

[Jed Shields]

Sorry for the confusion vcoolio, I'm actually filtering 3 different lists to 3 seperate sheets, one of them is =T&I IT, the other 2 are <>T&I IT, plus an additional filter of =VACANT and =FILLED in column 57. It' all working now, although I haven't looked at the extra code in post 7 yet.