Arnie,

This is a routine I use to loop through sheets in a workbook (bkname is the
name of the workbook you wnat to loop through)

bkname = ActiveWorkbook.Name
WSCount = ActiveWorkbook.Worksheets.Count

For a = 1 To WSCount
Workbooks(bkname).Activate
Sheets(a).Activate
ROUTINE TO RUN HERE
Workbooks(bkname).Activate (Very important to take focus back to the
desired workbook)
Next a

Hope this helps
--
Paul Cordts


"Arnie" wrote:

I've had some helpful answers already but nothing I've tried has fully
succeeded. I can't seem to get the macro to advance to the next worksheet.

I want to put a loop around this macro so that it will be run on every
worksheet in the workbook. It is in a workbook named DATA COLLECTION and
copies sheets to another workbook named DATA STORAGE AND RETRIEVAL.

TIA

Sub Data_Mover()
Application.Run "'DATA COLLECTION.xls'!StopTimer_Collect"
Windows("DATA COLLECTION").Activate

Dim wksName As String
wksName = ActiveSheet.Name

Dim wbk As Workbook

On Error Resume Next
Set wbk = Workbooks("DATA STORAGE AND RETRIEVAL.xls")
On Error GoTo 0

If wbk Is Nothing Then
'MsgBox "Opening DATA STORAGE AND RETRIEVAL"
Set wbk = Workbooks.Open("P:\Bowling Green\QA DATA\QA DATA
COLLECTION\DATA STORAGE AND RETRIEVAL.xls")
Windows("DATA COLLECTION").Activate
End If

Application.DisplayAlerts = False 'not "are you sure prompt"
On Error Resume Next 'in case it isn't there
Workbooks("DATA STORAGE AND RETRIEVAL").Worksheets(wksName).Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets(wksName).Select
ActiveSheet.Unprotect
Worksheets(wksName).Copy After:=Workbooks( _
"DATA STORAGE AND RETRIEVAL").Worksheets("DATA STORAGE AND
RETRIEVAL")
ActiveWindow.FreezePanes = False
Rows("11:11").Select
Selection.Insert Shift:=xlDown
Rows("10:10").Select
Selection.Copy
Rows("11:11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("10:10").Delete
Rows("1:7").Delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
ActiveWindow.SelectedSheets.Visible = False
Windows("DATA COLLECTION").Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells

Application.Run "'DATA COLLECTION.xls'!StartTimer_Collect"
End Sub
--
n00b lookn for a handout :)