|
Run macro on every worksheet
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 :) |
Run macro on every worksheet
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 :) |
Run macro on every worksheet
Thanks! This is much much closer to what I'm trying to do. Now I just need
to figure out how to exclude some hidden worksheets. -- n00b lookn for a handout :) "Paul Cordts" wrote: 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 :) |
Run macro on every worksheet
For a = 1 To WSCount
If Sheets(a).visible=false then goto skip1: Workbooks(bkname).Activate Sheets(a).Activate ROUTINE TO RUN HERE Workbooks(bkname).Activate (Very important to take focus back to the desired workbook) skip1: Next a -- Paul Cordts "Arnie" wrote: Thanks! This is much much closer to what I'm trying to do. Now I just need to figure out how to exclude some hidden worksheets. -- n00b lookn for a handout :) "Paul Cordts" wrote: 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 :) |
Run macro on every worksheet
That was the final piece to my puzzle! Thank you so much for your help!
-- n00b lookn for a handout :) "Paul Cordts" wrote: For a = 1 To WSCount If Sheets(a).visible=false then goto skip1: Workbooks(bkname).Activate Sheets(a).Activate ROUTINE TO RUN HERE Workbooks(bkname).Activate (Very important to take focus back to the desired workbook) skip1: Next a -- Paul Cordts "Arnie" wrote: Thanks! This is much much closer to what I'm trying to do. Now I just need to figure out how to exclude some hidden worksheets. -- n00b lookn for a handout :) "Paul Cordts" wrote: 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 :) |
| All times are GMT +1. The time now is 09:52 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com