Quite simple Im sure

Dim x As Integer
x = 1
For x = 1 To 12
Worksheets(x).Select



Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x

I am trying to copy the data from each sheet from a5:i5 down but it doesnt
work if there is nothing in the range. How do I fix it?
Thanks!

Try this. I shortened it up some for you.

Dim ws As Worksheet
x = 1
For x = 1 To 12
Set ws = Worksheets(x)
If ws.Range("A6") = "" Then
'Range is empty
MsgBox "Range is empty, Aborting Macro."
Exit Sub
End If
ws.Range(ws.Range("A5"), Range("I" & ws.Rows.Count).End(xlUp)).Copy _
Worksheets("Summary").Range("A" &
Worksheets("Summary").Rows.Count).End _
(xlUp).Offset(1)
Next x

--
Charles Chickering

"A good example is twice the value of good advice."


"Al" wrote:

Quite simple Im sure

Dim x As Integer
x = 1
For x = 1 To 12
Worksheets(x).Select



Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x

I am trying to copy the data from each sheet from a5:i5 down but it doesnt
work if there is nothing in the range. How do I fix it?
Thanks!

One way:

For x = 1 To 12
Worksheets(x).Select
Range("A5:I5").Select

Range(Selection, Selection.End(xlDown)).Select
If Selection.End(xlDown).Row < 65536 _
Then
Selection.Copy
Worksheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Else:
End If
Next x


"Al" wrote in message
...
Quite simple Im sure

Dim x As Integer
x = 1
For x = 1 To 12
Worksheets(x).Select



Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x

I am trying to copy the data from each sheet from a5:i5 down but it doesnt
work if there is nothing in the range. How do I fix it?
Thanks!

Thanks!

"PCLIVE" wrote:

One way:

For x = 1 To 12
Worksheets(x).Select
Range("A5:I5").Select

Range(Selection, Selection.End(xlDown)).Select
If Selection.End(xlDown).Row < 65536 _
Then
Selection.Copy
Worksheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Else:
End If
Next x


"Al" wrote in message
...
Quite simple Im sure

Dim x As Integer
x = 1
For x = 1 To 12
Worksheets(x).Select



Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x

I am trying to copy the data from each sheet from a5:i5 down but it doesnt
work if there is nothing in the range. How do I fix it?
Thanks!

Just a thought Al.

In case the Selection to be copied only has one row the ending row would
still be 65536, thus causing you to lose that one row of data. So you may
want to adjust the code slightly. This will copy the single row range, even
when blank, and paste the blank selection to the next available row on the
destination sheet. The result is transparent and should not effect anything
when the row is blank. However, if it is a single row of data, then it gets
copied over as expected.

For x = 1 To 12
Worksheets(x).Select
Range("A5:I5").Select

If Selection.End(xlDown).Row < 65536 _
Then
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Else:
Selection.Copy
Worksheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next x


HTH,
Paul

"Al" wrote in message
...
Thanks!

"PCLIVE" wrote:

One way:

For x = 1 To 12
Worksheets(x).Select
Range("A5:I5").Select

Range(Selection, Selection.End(xlDown)).Select
If Selection.End(xlDown).Row < 65536 _
Then
Selection.Copy
Worksheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Else:
End If
Next x


"Al" wrote in message
...
Quite simple Im sure

Dim x As Integer
x = 1
For x = 1 To 12
Worksheets(x).Select



Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Summary").Select
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x

I am trying to copy the data from each sheet from a5:i5 down but it
doesnt
work if there is nothing in the range. How do I fix it?
Thanks!