Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Little more advice on this code | Excel Discussion (Misc queries) | |||
Trying to improving existing code (portion of) | Excel Programming | |||
Code advice please... | Excel Programming | |||
Improving code.....For Next | Excel Programming | |||
Need advice and code help with working with *.dbf files in Excel 97 | Excel Programming |