Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code.
Code that solved a previous post from Tom for me:
~~~~ Dim sh as Worksheet for each sh in Thisworkbook.Worksheets if sh.Name < "Sheet1" and sh.name _ < "Sheet2" and sh.Name < "Sheet3" then ' do something with Sh end if Next ~~~~ But as this code has a copy of each named sheet placed into a new workbook, THEN copies a Utilisation Sheet(sheet with data & graphs from c/button) on it. I cannot sem to work out how to adapt the above to the code below. The aim is that when other sheets are added to this workbook, then they ALSO will be copied in this code when it is run. The below code is designed to copy a designated range from each of the sheets(employee timesheet) and place it (protected) in a new workbook for that week, then named the end of payweek date. The below code also has a copy of the Utilisation sheet. This has numerous commandbuttons on it to display graphs from the data values on that sheet. I need this info to be save also into the new workbook. ~~~~~~~~~~~~~~~~~~~~~ Sub Export_TimeSheets() Call Unprotect res = InputBox("Are you sure you want to Store the TimeSheets NOW ?" & vbCrLf & vbCrLf & "This will not allow for anymore modifications...." & vbCrLf & vbCrLf & vbTab & vbTab & "yes - (All lower case to continue).", "....") If res = "yes" Then Application.ScreenUpdating = False Application.DisplayAlerts = False ' Create a New WorkBook and Copy TimeSheets into it for Storage ' name 8 TimeSheet Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 8") .Select .Range("a1:u41").Copy Workbooks.Add Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet1").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet1").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet1").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' Temporarily Name & Save the WorkBook into the TimeSheets Folder.... ChDir "\\Office2\my documents\TimeSheets" ActiveWorkbook.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\Temporary Name.xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False ' ADD name 7 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 7") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet3").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet3").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet3").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet3").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name 6 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 6") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet4").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet4").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet4").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet4").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name 5 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 5") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet5").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet5").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet5").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet5").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD Name 5 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("Name 5") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet6").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet6").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet6").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet6").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name 4 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 4") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet7").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet7").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet7").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet7").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name 3 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 3") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet8").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet8").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet8").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet8").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name 2 TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 2") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet9").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet9").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet9").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet9").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' ADD name1TimeSheet Here <===================================== Workbooks("TimeSheets").Activate Application.DisplayAlerts = False With ActiveWorkbook.Sheets("name 1") .Select .Range("a1:u41").Copy Workbooks("Temporary Name").Activate Sheets.Add Sheets("Sheet10").Select Application.CommandBars("Task Pane").Visible = False Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").Select Selection.ColumnWidth = 1 Sheets("Sheet10").Range("A1:U42").PasteSpecial Paste:=xlPasteValues Sheets("Sheet10").Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ' Place a Border Around TimeSheet Range("A1:U42").Select Range("U42").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select ' Name the TimeSheet the Value in Cell K2 ActiveSheet.Name = Worksheets("Sheet10").Range("K2").Value Cells.Select ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet.EnableSelection = xlNoSelection Application.DisplayAlerts = False ' Copy/Paste Utilization Sheet with graphs Call SheetMove Columns("A:B").Select Selection.ColumnWidth = 10 Columns("C:AA").Select Selection.ColumnWidth = 5 Columns("X:X").Select Selection.ColumnWidth = 7 ActiveSheet.Name = Worksheets("Utilization Sheet").Range("B1").Value Range("A1").Select Call SheetMove2 With Sheets("Sheet2").Delete End With With Sheets("Utilization Sheet") .Select ActiveSheet.Shapes("CommandButton22").Select Selection.Delete End With Sheets("Leave Blank").Select ActiveWindow.DisplayWorkbookTabs = True ' Name & Save the WorkBook into the TimeSheets Folder ChDir "\\Office2\my documents\TimeSheets" ActiveWorkbook.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\" & Sheet1.Range("E2").Text & ".xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _ CreateBackup:=False Call protect ActiveWorkbook.Close Sheets("Enter - Exit").Select Dim myrange As Range Set myrange = Range("E2") Application.DisplayAlerts = True ' Turning it back on MsgBox "The TimeSheets have been Stored as the Week Ending " & myrange.Value & " .", , "...." Workbooks("TimeSheets").Activate Sheets("Enter - Exit").Select Range("A1").Select Call Unprotect Application.ScreenUpdating = False Sheets("name 8").Select Call ClearTimeSheetValues Sheets("Enter - Exit").Select Range("A1").Select Call protect Application.DisplayAlerts = False If Dir("\\Office2\my documents\TimeSheets\Temporary Name.xls") < "" Then _ Kill "\\Office2\my documents\TimeSheets\Temporary name.xls" Application.DisplayAlerts = True ' Turning it back on Else MsgBox "Please change what you need to and then try again.", , "...." End If End Sub ~~~~~~~~~~~~~~~~~~~~~ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code.
It is pretty hard to figure out what you are doing with all the selects and
sheet activates, but this is my guess for the Loop part: for the part past the loop, you are calling procedures I can't see and it depends on which sheet is active and so forth - and I have no idea which sheet is active - and it is always best to avoid writing code that depends on a sheet being active. in my code, bk1 is the workbook that was added. (Temporary Name.xls I would Assume) bk is the workbook active at the time you started the procedure. (Timesheets.xls I would assume) Sub Export_TimeSheets() Dim bk as Workbook, bk1 as Workbook set bk = ActiveWorkbook Call Unprotect res = InputBox("Are you sure you want to Store the TimeSheets NOW ?" & vbCrLf & vbCrLf & "This will not allow for anymore modifications...." & vbCrLf & vbCrLf & vbTab & vbTab & "yes - (All lower case to continue).", "....") If res < "yes" Then MsgBox "Please change what you need to and then try again.", , "...." exit sub end if Application.ScreenUpdating = False Application.DisplayAlerts = False ' Create a New WorkBook and Copy TimeSheets into it for Storage ' name 8 TimeSheet Workbooks.Add set bk1 = ActiveWorkbook ' Temporarily Name & Save the WorkBook into the TimeSheets Folder.... bk1.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\Temporary Name.xls", _ FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Application.DisplayAlerts = False ' ' loop to copy sheets ' for each sh in bk.Worksheets if sh.Name < "Sheet1" and sh.Name < _ "sheet2" and sh.Name < "Sheet3" then set sh1 = bk1.Worksheets.Add( After:=bk1.Worksheets(bk1.Worksheets.count)) sh.Range("a1:u41").Copy Application.CommandBars("Task Pane").Visible = False sh1.Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").ColumnWid th = 1 sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteValues sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False ' Place a Border Around TimeSheet With sh1.Range("A1:U42") .Item(1).Activate .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone with .Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select sh1.Name = sh1.Range("K2").Value sh1.Cells.Select sh1.protect DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True sh1.EnableSelection = xlNoSelection Application.DisplayAlerts = False Next sh ' ' End of loop to copy sheets ' ' no way I can tell what is going on in the next sequence. You call ' procedures I can not see and take actions on the activesheet, but no way I can ' know what sheet is active since you have executed unknown code with your calls to ' SheetMove and SheetMove2 and so forth. ' Copy/Paste Utilization Sheet with graphs Call SheetMove Columns("A:B").Select Selection.ColumnWidth = 10 Columns("C:AA").Select Selection.ColumnWidth = 5 Columns("X:X").Select Selection.ColumnWidth = 7 ActiveSheet.Name = Worksheets("Utilization Sheet").Range("B1").Value Range("A1").Select Call SheetMove2 With Sheets("Sheet2").Delete End With With Sheets("Utilization Sheet") .Select ActiveSheet.Shapes("CommandButton22").Select Selection.Delete End With Sheets("Leave Blank").Select ActiveWindow.DisplayWorkbookTabs = True ' Name & Save the WorkBook into the TimeSheets Folder ChDir "\\Office2\my documents\TimeSheets" ActiveWorkbook.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\" & Sheet1.Range("E2").Text & ".xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _ CreateBackup:=False Call protect ActiveWorkbook.Close Sheets("Enter - Exit").Select Dim myrange As Range Set myrange = Range("E2") Application.DisplayAlerts = True ' Turning it back on MsgBox "The TimeSheets have been Stored as the Week Ending " & myrange.Value & " .", , "...." Workbooks("TimeSheets").Activate Sheets("Enter - Exit").Select Range("A1").Select Call Unprotect Application.ScreenUpdating = False Sheets("name 8").Select Call ClearTimeSheetValues Sheets("Enter - Exit").Select Range("A1").Select Call protect Application.DisplayAlerts = False If Dir("\\Office2\my documents\TimeSheets\Temporary Name.xls") < "" Then _ Kill "\\Office2\my documents\TimeSheets\Temporary name.xls" Application.DisplayAlerts = True ' Turning it back on End sub -- regards, Tom Ogilvy |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code.
thanks for the reply again Tom.
I seem to get an error at the : Next sh line. It sems to need to go to the end of the code, but i needs to go before the other sheet it copied in? I copy/pasted you code with no changes. Yes you guesses of the wb names were correct. Corey.... "Tom Ogilvy" wrote in message ... It is pretty hard to figure out what you are doing with all the selects and sheet activates, but this is my guess for the Loop part: for the part past the loop, you are calling procedures I can't see and it depends on which sheet is active and so forth - and I have no idea which sheet is active - and it is always best to avoid writing code that depends on a sheet being active. in my code, bk1 is the workbook that was added. (Temporary Name.xls I would Assume) bk is the workbook active at the time you started the procedure. (Timesheets.xls I would assume) Sub Export_TimeSheets() Dim bk as Workbook, bk1 as Workbook set bk = ActiveWorkbook Call Unprotect res = InputBox("Are you sure you want to Store the TimeSheets NOW ?" & vbCrLf & vbCrLf & "This will not allow for anymore modifications...." & vbCrLf & vbCrLf & vbTab & vbTab & "yes - (All lower case to continue).", "....") If res < "yes" Then MsgBox "Please change what you need to and then try again.", , "...." exit sub end if Application.ScreenUpdating = False Application.DisplayAlerts = False ' Create a New WorkBook and Copy TimeSheets into it for Storage ' name 8 TimeSheet Workbooks.Add set bk1 = ActiveWorkbook ' Temporarily Name & Save the WorkBook into the TimeSheets Folder.... bk1.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\Temporary Name.xls", _ FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Application.DisplayAlerts = False ' ' loop to copy sheets ' for each sh in bk.Worksheets if sh.Name < "Sheet1" and sh.Name < _ "sheet2" and sh.Name < "Sheet3" then set sh1 = bk1.Worksheets.Add( After:=bk1.Worksheets(bk1.Worksheets.count)) sh.Range("a1:u41").Copy Application.CommandBars("Task Pane").Visible = False sh1.Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").ColumnWid th = 1 sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteValues sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False ' Place a Border Around TimeSheet With sh1.Range("A1:U42") .Item(1).Activate .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone with .Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select sh1.Name = sh1.Range("K2").Value sh1.Cells.Select sh1.protect DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True sh1.EnableSelection = xlNoSelection Application.DisplayAlerts = False Next sh ' ' End of loop to copy sheets ' ' no way I can tell what is going on in the next sequence. You call ' procedures I can not see and take actions on the activesheet, but no way I can ' know what sheet is active since you have executed unknown code with your calls to ' SheetMove and SheetMove2 and so forth. ' Copy/Paste Utilization Sheet with graphs Call SheetMove Columns("A:B").Select Selection.ColumnWidth = 10 Columns("C:AA").Select Selection.ColumnWidth = 5 Columns("X:X").Select Selection.ColumnWidth = 7 ActiveSheet.Name = Worksheets("Utilization Sheet").Range("B1").Value Range("A1").Select Call SheetMove2 With Sheets("Sheet2").Delete End With With Sheets("Utilization Sheet") .Select ActiveSheet.Shapes("CommandButton22").Select Selection.Delete End With Sheets("Leave Blank").Select ActiveWindow.DisplayWorkbookTabs = True ' Name & Save the WorkBook into the TimeSheets Folder ChDir "\\Office2\my documents\TimeSheets" ActiveWorkbook.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\" & Sheet1.Range("E2").Text & ".xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _ CreateBackup:=False Call protect ActiveWorkbook.Close Sheets("Enter - Exit").Select Dim myrange As Range Set myrange = Range("E2") Application.DisplayAlerts = True ' Turning it back on MsgBox "The TimeSheets have been Stored as the Week Ending " & myrange.Value & " .", , "...." Workbooks("TimeSheets").Activate Sheets("Enter - Exit").Select Range("A1").Select Call Unprotect Application.ScreenUpdating = False Sheets("name 8").Select Call ClearTimeSheetValues Sheets("Enter - Exit").Select Range("A1").Select Call protect Application.DisplayAlerts = False If Dir("\\Office2\my documents\TimeSheets\Temporary Name.xls") < "" Then _ Kill "\\Office2\my documents\TimeSheets\Temporary name.xls" Application.DisplayAlerts = True ' Turning it back on End sub -- regards, Tom Ogilvy |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code.
Application.DisplayAlerts = False
End With End If Next sh ' ' End of loop to copy sheets ' Copy/Paste Utilization Sheet with graphs Done. Had to shuffle a few end with and end if lines around to get it to work. Cheers Tom. "Corey" wrote in message ... thanks for the reply again Tom. I seem to get an error at the : Next sh line. It sems to need to go to the end of the code, but i needs to go before the other sheet it copied in? I copy/pasted you code with no changes. Yes you guesses of the wb names were correct. Corey.... "Tom Ogilvy" wrote in message ... It is pretty hard to figure out what you are doing with all the selects and sheet activates, but this is my guess for the Loop part: for the part past the loop, you are calling procedures I can't see and it depends on which sheet is active and so forth - and I have no idea which sheet is active - and it is always best to avoid writing code that depends on a sheet being active. in my code, bk1 is the workbook that was added. (Temporary Name.xls I would Assume) bk is the workbook active at the time you started the procedure. (Timesheets.xls I would assume) Sub Export_TimeSheets() Dim bk as Workbook, bk1 as Workbook set bk = ActiveWorkbook Call Unprotect res = InputBox("Are you sure you want to Store the TimeSheets NOW ?" & vbCrLf & vbCrLf & "This will not allow for anymore modifications...." & vbCrLf & vbCrLf & vbTab & vbTab & "yes - (All lower case to continue).", "....") If res < "yes" Then MsgBox "Please change what you need to and then try again.", , "...." exit sub end if Application.ScreenUpdating = False Application.DisplayAlerts = False ' Create a New WorkBook and Copy TimeSheets into it for Storage ' name 8 TimeSheet Workbooks.Add set bk1 = ActiveWorkbook ' Temporarily Name & Save the WorkBook into the TimeSheets Folder.... bk1.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\Temporary Name.xls", _ FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Application.DisplayAlerts = False ' ' loop to copy sheets ' for each sh in bk.Worksheets if sh.Name < "Sheet1" and sh.Name < _ "sheet2" and sh.Name < "Sheet3" then set sh1 = bk1.Worksheets.Add( After:=bk1.Worksheets(bk1.Worksheets.count)) sh.Range("a1:u41").Copy Application.CommandBars("Task Pane").Visible = False sh1.Range("A:A,D:D,G:G,J:J,M:M,P:P,S:S").ColumnWid th = 1 sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteValues sh1.Range("A1:U42").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False ' Place a Border Around TimeSheet With sh1.Range("A1:U42") .Item(1).Activate .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone with .Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With With .Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 56 End With Range("A1").Select sh1.Name = sh1.Range("K2").Value sh1.Cells.Select sh1.protect DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True sh1.EnableSelection = xlNoSelection Application.DisplayAlerts = False Next sh ' ' End of loop to copy sheets ' ' no way I can tell what is going on in the next sequence. You call ' procedures I can not see and take actions on the activesheet, but no way I can ' know what sheet is active since you have executed unknown code with your calls to ' SheetMove and SheetMove2 and so forth. ' Copy/Paste Utilization Sheet with graphs Call SheetMove Columns("A:B").Select Selection.ColumnWidth = 10 Columns("C:AA").Select Selection.ColumnWidth = 5 Columns("X:X").Select Selection.ColumnWidth = 7 ActiveSheet.Name = Worksheets("Utilization Sheet").Range("B1").Value Range("A1").Select Call SheetMove2 With Sheets("Sheet2").Delete End With With Sheets("Utilization Sheet") .Select ActiveSheet.Shapes("CommandButton22").Select Selection.Delete End With Sheets("Leave Blank").Select ActiveWindow.DisplayWorkbookTabs = True ' Name & Save the WorkBook into the TimeSheets Folder ChDir "\\Office2\my documents\TimeSheets" ActiveWorkbook.SaveAs Filename:= _ "\\Office2\my documents\TimeSheets\" & Sheet1.Range("E2").Text & ".xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _ CreateBackup:=False Call protect ActiveWorkbook.Close Sheets("Enter - Exit").Select Dim myrange As Range Set myrange = Range("E2") Application.DisplayAlerts = True ' Turning it back on MsgBox "The TimeSheets have been Stored as the Week Ending " & myrange.Value & " .", , "...." Workbooks("TimeSheets").Activate Sheets("Enter - Exit").Select Range("A1").Select Call Unprotect Application.ScreenUpdating = False Sheets("name 8").Select Call ClearTimeSheetValues Sheets("Enter - Exit").Select Range("A1").Select Call protect Application.DisplayAlerts = False If Dir("\\Office2\my documents\TimeSheets\Temporary Name.xls") < "" Then _ Kill "\\Office2\my documents\TimeSheets\Temporary name.xls" Application.DisplayAlerts = True ' Turning it back on End sub -- regards, Tom Ogilvy |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Code Help for naming a worksheet tab | Excel Discussion (Misc queries) | |||
Apply code to other worksheets | Excel Programming | |||
run code on opening workbook and apply code to certain sheets | Excel Programming | |||
Shorten Code for repeated function use | Excel Programming | |||
Shorten Code? | Excel Programming |