Change "Selection.CurrentRegion.Select" so macro captures cols A-Q, non-contiguous

[1819]

I need this macro to select non-contiguous cells.

Column Q is always populated, but each row can vary as to whether columns A to P are filled.

"Selection.CurrentRegion.Select" is restricting the macro to contiguous cells - so how can I change it to select columns A to Q?



Sub Combine()

Dim J As Integer
Dim s As Worksheet

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then
Application.GoTo Sheets(s.Name).[a1]
Selection.CurrentRegion.Select

Selection.Copy Destination:=Sheets("Combined"). _
Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next
End Sub



Thanks.

[SamT]

Includes Row 1

Set myRange = Intersect(UsedRange, Range("A:Q"))
Skips Row 1

Set myRange = Intersect(UsedRange, Range("A:Q")).Offset(1, 0)

[SamT]

' copy headings
Sheets(2).Rows(1).Copy Destination:=Sheets(1).Range("A1")

For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then _
s.Range(Intersect(UsedRange, Range("A:Q"))).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp)(2)
Next
May need to adjust dots at UsedRange and or Range("A:Q")

[1819]

Thanks for the very rapid response.

I'm getting a "Compile Error: Variable not defined" for UsedRange.

This is what I did with your solution - what have I done wrong? Thanks.



Sub Combine()

Dim J As Integer
Dim s As Worksheet

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

Set MyRange = Intersect(UsedRange, Range("A:Q"))

'copy headings
Sheets(2).Rows(1).Copy Destination:=Sheets(1).Range("A1")

For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then _
s.Range(Intersect(UsedRange, Range("A:Q"))).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp)(2)
Next


End Sub

[SamT]

s Dot UsedRange

s.UsedRange

What are j and MyRange used for in your code?

"Compile Error: Variable not defined" Usually means you forgot to Declare the variable with a Dim statement. However in the correct syntax, UsedRange is a Worksheet Property. Besides, you aren't using Option Explicit.

[1819]

Thanks for this. The Option Explicit was declared further up the module so I have repeated it here.

Please could you explain while I'm getting "RunTime Error 1004 Method 'Intersect' of object '_Global' failed" at lines:



s.Range(Intersect(s.UsedRange, Range("A:Q"))).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp)(2)


in


Option Explicit

Sub Combine()

Dim s As Worksheet

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"


'copy headings
Sheets(2).Rows(1).Copy Destination:=Sheets(1).Range("A1")

For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then _
s.Range(Intersect(s.UsedRange, Range("A:Q"))).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp)(2)
Next


End Sub



Thanks.

[SamT]

I was able to duplicate the error by running the code on a workbook with an empty sheet. There is no UsedRange on a blank WorkSheet.

on an Empty sheet, s.Cells.SpecialCells(xlCellTypeLastCell).Address = "$A$1"


Sub Combine()

Dim s As Worksheet

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"


'copy headings
Sheets(2).Rows(1).Copy Destination:=Sheets(1).Range("A1")

For Each s In ThisWorkbook.Sheets
If s.Name <> "Combined" Then _
s.Range(Intersect(s.UsedRange, Range("A:Q"))).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp)(2)
Next


End Sub

[1819]

Thanks for the tip about empty sheets. I have removed them now.

I also had some non-text junk which I have removed, and have checked there are no blank rows.

But still I cannot get it to work - the same error appears: "RunTime Error 1004 Method 'Intersect' of object '_Global' failed".

Here's a basic version of the file: https://www.dropbox.com/s/bsri37knt1vnvj3/Specimen.xlsm?dl=0

Grateful for any pointers. Thanks.

[SamT]

After the Add operation, "Sheets(2)" gave an error, any other index number worked ok :dunno

Sub Combine()

Dim s As Worksheet
Dim S1 As Worksheet
Set S1 = ActiveSheet '<<<

On Error Resume Next
Sheets("Combined").Delete '<<<< Handy for development. Also tells you when it already exists

Worksheets.Add Sheets(1) ' add a sheet in first place
Sheets(1).Name = "Combined"

'copy headings
S1.Rows(1).Copy Destination:=Sheets("Combined").Range("A1")

For Each s In Sheets
If s.Name <> "Combined" Then _
Intersect(s.UsedRange, s.Range("A:Q")).Offset(1).Copy _
Destination:=Sheets("Combined").Cells(Rows.Count, 1).End(xlUp) (2)
Next
End Sub

[1819]

SamT, take a bow. It works now! Fantastic. Thank you so much for sticking with it.