Help with For...each...next

[Arnie]

The following code is in a regular module in a workbook named DATA
COLLECTION. It checks to see if a worksheet with the same name as the active
worksheet exists in another workbook named DATA STORAGE AND RETRIEVAL. If
the sheet name does not exist, the sheet from DATA COLLECTION is copied over.
If it does, the like-named sheet is first deleted from DATA STORAGE AND
RETRIEVAL and then the sheet is copied over. (this was created with a lot of
help from this board)

I want to use a For...each...next loop to check all sheet names in DATA
COLLECTION but I think I'm having trouble with my object names or variables.
The sub runs only on the sheet that is active when it starts (I believe).
Can anyone help me trouble shoot this?

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

For Each Worksheet in Worksheets

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

Next

Application.Run "'DATA COLLECTION.xls'!StartTimer_Collect"

End Sub

 

[Gary''s Student]

This seems to work. It assumes both workbooks are open. You might want to
turn off display alerts as well:

Sub copyover()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim sh As Worksheet
Set wb1 = Workbooks("DATA COLLECTION.xls")
Set wb2 = Workbooks("DATA STORAGE AND RETRIEVAL.xls")

wb1.Activate
cName = ActiveSheet.Name
MsgBox (cName)

isthere = False
For Each sh In wb2.Worksheets
If sh.Name = cName Then
isthere = True
End If
Next

If isthere Then
wb2.Activate
Sheets(cName).Delete
End If

wb1.Activate
ActiveSheet.Copy Before:=wb2.Sheets(1)
End Sub

 

[Arnie]

This still isn't quite right. I want to perform the routine on each
worksheet in DATA COLLECTION.

The sub works great when I'm only concerned with the active sheet but I
can't seem to get it to cycle thru all sheet names in DATA COLLECTION.