advice on improving code
 

Hi,

Could somebody let me know if there is a better way to perform the loop
function in the code below. Currently the "Do Until" loop starts at sheet 4
(This part will always be the same) and continues to loop until it reaches
sheet 14 (this is fine unless there is a new sheet added or one taken away)

How would I perform the loop until there are no worksheets left to activate
instead of specifying the number of sheets

Thanks in advance.



Sub Update_Database()

' Clear Current Data
Application.Worksheets("Data").Activate
Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Dim i As Integer
i = 3

Do Until i = 14
i = i + 1

Application.Worksheets(i).Activate

Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Data").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Loop

End Sub

advice on improving code
 

Here's a rewrite. Beware I've not used any test data.

Sub Update_Database()
Dim i As Long

With Worksheets("Data").Range("A4:I4")
Range(.Cells, .End(xlDown)).ClearContents
End With

For i = 4 To Worksheets.Count
With Worksheets(i).Range("A4:I4")
Range(.Cells, .End(xlDown)).Copy
End With
Worksheets("Data").Range("A1").End(xlDown) _
.Offset(1, 0).PasteSpecial xlPasteValues
Next
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/excel


"PC" <paulm DOT c at iol DOT ie wrote in message
...
Hi,

Could somebody let me know if there is a better way to perform the loop
function in the code below. Currently the "Do Until" loop starts at sheet
4
(This part will always be the same) and continues to loop until it reaches
sheet 14 (this is fine unless there is a new sheet added or one taken
away)

How would I perform the loop until there are no worksheets left to
activate
instead of specifying the number of sheets

Thanks in advance.



Sub Update_Database()

' Clear Current Data
Application.Worksheets("Data").Activate
Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Dim i As Integer
i = 3

Do Until i = 14
i = i + 1

Application.Worksheets(i).Activate

Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Data").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Loop

End Sub

advice on improving code
 

Sub Update_Database()

' Clear Current Data
Application.Worksheets("Data").Activate
Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).ClearContents

Dim i As Integer

For i = 4 To ActiveWorkbook.Worksheets.Count

Application.Worksheets(i).Activate

Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Copy

Sheets("Data").Select
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Next i

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"PC" <paulm DOT c at iol DOT ie wrote in message
...
Hi,

Could somebody let me know if there is a better way to perform the loop
function in the code below. Currently the "Do Until" loop starts at sheet
4
(This part will always be the same) and continues to loop until it reaches
sheet 14 (this is fine unless there is a new sheet added or one taken
away)

How would I perform the loop until there are no worksheets left to
activate
instead of specifying the number of sheets

Thanks in advance.



Sub Update_Database()

' Clear Current Data
Application.Worksheets("Data").Activate
Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Dim i As Integer
i = 3

Do Until i = 14
i = i + 1

Application.Worksheets(i).Activate

Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Data").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Loop

End Sub