Filter Data and Copy Multiple Sections

[reeser]

I have a list that I'd like to filter on Field 3 and copy the visible cells starting in A2 to column G then paste into Sheet2 A2. Then copy visible cells from J2 to M and paste into Sheet2 H2. Previously I was using this code for just the first part but I'm having trouble modifying it to handle copy/paste of the second section (J2-M). Any suggestions?

Sub Filter_NWSheet()

Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnStart As Range, rnData As Range

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")

With wsSheet
Set rnStart = .Range("A1")
Set rnData = .Range(.Range("A2"), .Cells(.Rows.Count, 7).End(xlUp))

End With

Application.ScreenUpdating = True

rnStart.AutoFilter Field:=3, Criteria1:="x"

rnData.SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("A2").PasteSpecial xlPasteValues


rnStart.AutoFilter Field:=3

With Application
.CutCopyMode = False
.ScreenUpdating = False
End With

End Sub

 

[BigC]

It's not very elegant but will adding the following code

With wsSheet
Set rnData = .Range(.Range("J2"), .Cells(.Rows.Count, 4).End(xlUp))
End With

rnData.SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("H2").PasteSpecial xlPasteValues

after

Sheets("Sheet2").Range("A2").PasteSpecial xlPasteValues

do it?


If you need to perform this task reqularly, an alternative that you may wish to explore - though this will require some structural changes to your workbook to add a criteria range and different code - is to use the Advanced Filter funtionality, as this will allow you to copy all the data you require in a single step.

HTH

 

[AlphaFrog]

Another example:

[COLOR=darkblue]Sub[/COLOR] Filter_NWSheet()
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] ThisWorkbook.Worksheets("Sheet1")
        .Range("A1").AutoFilter Field:=3, Criteria1:="x"
        .Range("A2", .Cells(.Rows.Count, "G").End(xlUp)).Copy
        Sheets("Sheet2").Range("A2").PasteSpecial xlPasteValues
        .Range("J2", .Cells(.Rows.Count, "M").End(xlUp)).Copy
        Sheets("Sheet2").Range("H2").PasteSpecial xlPasteValues
        .Range("A1").AutoFilter Field:=3
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]With[/COLOR] Application
        .CutCopyMode = [COLOR=darkblue]False[/COLOR]
        .ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]End[/COLOR] With
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[reeser]

Another example:

[COLOR=darkblue]Sub[/COLOR] Filter_NWSheet()
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]With[/COLOR] ThisWorkbook.Worksheets("Sheet1")
        .Range("A1").AutoFilter Field:=3, Criteria1:="x"
        .Range("A2", .Cells(.Rows.Count, "G").End(xlUp)).Copy
        Sheets("Sheet2").Range("A2").PasteSpecial xlPasteValues
        .Range("J2", .Cells(.Rows.Count, "M").End(xlUp)).Copy
        Sheets("Sheet2").Range("H2").PasteSpecial xlPasteValues
        .Range("A1").AutoFilter Field:=3
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]With[/COLOR] Application
        .CutCopyMode = [COLOR=darkblue]False[/COLOR]
        .ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]End[/COLOR] With
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

That is perfect. Thanks for taking a look at it and coming up with a solution.