Intersect Object VBA excel 2010. Please Help

[michellebenton2012]

Hi,

I have been posting frequently regarding a new Macro I have been working on. It seems that everytime I fix one thing, I have to debug another. All in all I want to copy several wksheets rows into one based on if column L has an "A" and as well only copy the columns :B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")). However, now I am receiving the error that my intersect code object doesnt support property method. Would really appreciate the help with this as I am on a time crunch. Thanks!

Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")).Copy_
Sheets(strConsTab).Cells(Rows.Count, "B").End(xlUp).Offset (1)
ws.AutoFilterMode = False




Entire Code:

Private Sub Worksheet_Activate()
'Consolidates data from the range B6:Q2215 for every tab except the one it's part of.
Dim wrkSheet As Worksheet
Dim rngCopy As Range
Dim lngPasteRow As Long
Dim strConsTab As String
Dim lastrow As Long




strConsTab = ActiveSheet.Name 'Consolidation sheet tab name based on active tab'.

If Sheets(strConsTab).Cells(Rows.Count, "B").End(xlUp).Row >= 2 Then
If MsgBox("Do you want to clear the existing consolidated data in """ & strConsTab & """", vbQuestion + vbYesNo, "Data Consolidation Editor") = vbYes Then
Sheets(strConsTab).Range("B6:Q" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
End If
End If

Application.ScreenUpdating = False


For Each wrkSheet In ActiveWorkbook.Worksheets

If InStr("Inactive|Head Count|Colombia|China JV|Sustain|AMS|" & ActiveSheet.Name, wrkSheet.Name) = 0 Then

lastrow = wrkSheet.Range("b" & Rows.Count).End(xlUp).Row
If lastrow > 6 Then
If IsNumeric(Application.Match("A", ws.Range("L6:L" & lastrow), 0)) Then 'Test if column L has any "A" values
ws.Range("A6:R" & lastrow).AutoFilter 12, "A" 'Autofilter column L where row 6 is the header row
' Copy filtered values from specific columns to destination worksheet
Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")).Copy_
Sheets(strConsTab).Cells(Rows.Count, "B").End(xlUp).Offset (1)
ws.AutoFilterMode = False
End If

End If
End If


Next

Application.ScreenUpdating = True

End Sub

 

[Rick Rothstein]

Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")).Copy_
Sheets(strConsTab).Cells(Rows.Count, "B").End(xlUp).Offset (1)
ws.AutoFilterMode = False

Excel cannot copy multiple non-contiguous cells when those cells are not all on the same row or are not all in the same column... VBA has that same restriction. The way to reach is set of cells within the intersection is to use a For Each loop and apply it to the Intersection's Areas property. Not sure of exactly where you wanted each individual area to go to, so I kind of left that part for you to fill in, but its structure is something like this...

Dim CellArea As Range
For Each CellArea In Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")).Areas
  CellArea.Copy ....{destination goes here}....
Next

 

[AlphaFrog]

This method can copy noncontinuous columns.
You are missing a space between the .Copy and the underscore.

[FONT=courier new]Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R"))[B][COLOR=#ff0000].Copy _[/COLOR][/B]
                   Sheets(strConsTab).Cells(Rows.Count, "B").End(xlUp).Offset(1)[/FONT]

Not sure why you started a new thread though. It would have been better to ask this from your original thread.

 

[Rick Rothstein]

Excel cannot copy multiple non-contiguous cells when those cells are not all on the same row or are not all in the same column... VBA has that same restriction. The way to reach is set of cells within the intersection is to use a For Each loop and apply it to the Intersection's Areas property. Not sure of exactly where you wanted each individual area to go to, so I kind of left that part for you to fill in, but its structure is something like this...

Dim CellArea As Range
For Each CellArea In Intersect(wrkSheet.Range("A6:R" & lastrow), wrkSheet.Range("B:B,E:E,G:J,L:L,N:N,Q:Q,R:R")).Areas
  CellArea.Copy ....{destination goes here}....
Next

This method can copy noncontinuous columns.

AlphaFrog is right... I stand corrected. For some reason, I was thinking of non-contiguous ranges like "B4:C6,F7:F10,I5:K5" that have no regularity about them which cannot be copied as is and needs to be done by areas; however, an Intersection should never produce such non-contiguous ranges.