| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with For...each...next
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 -- n00b lookn for a handout :) |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with For...each...next
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 Befo=wb2.Sheets(1) End Sub -- Gary''s Student - gsnu200749 "Arnie" wrote: 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 -- n00b lookn for a handout :) |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help with For...each...next
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. -- n00b lookn for a handout :) "Gary''s Student" wrote: 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 Befo=wb2.Sheets(1) End Sub -- Gary''s Student - gsnu200749 "Arnie" wrote: 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 -- n00b lookn for a handout :) |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Linear Mode
