Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
|
|||
|
|||
![]()
A couple of things I would like to add to this macro is a prompt at the
beginning that says "Please enter hours and miles first" True = continue False = end The second thing is on the Workbooks.Open command. Is there a way to have all links and formulas to update and save without opening? If not I would like a user prompt for each number or better yet can it look at a list of tech numbers and match them to say "R2C3:R200C3" like you would write an Index and Match formula in Excel? ActiveSheet.Unprotect Application.Goto Reference:="R2C9:R200C15" Selection.ClearContents Application.Goto Reference:="R2C24:R200C28" Selection.ClearContents Application.Goto Reference:="R2C35:R200C39" Selection.ClearContents Range("A2").Select Workbooks.Open ("C:\IMPORT.XLS") Application.Goto Reference:="R200C15" ActiveCell.FormulaR1C1 = " " Application.Goto Reference:="R200C16" ActiveCell.FormulaR1C1 = " " Application.Goto Reference:="R2C1:R200C1" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C1:R200C1" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C3:R200C3" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C2:R200C2" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C4:R200C4" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C3:R200C3" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C5:R200C5" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C4:R200C4" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C6:R200C6" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C5:R200C5" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C8:R200C8" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C6:R200C6" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C9:R200C9" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C7:R200C7" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C10:R200C10" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C8:R200C8" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C11:R200C11" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C9:R200C9" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.TextToColumns Destination:=Range("I2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _ "-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C16:R200C16" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C24:R200C24" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False Selection.TextToColumns Destination:=Range("X2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _ "-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True Windows("IMPORT.XLS").Activate Application.Goto Reference:="R2C15:R200C15" Selection.Copy Windows("1DLSUNDAY.XLS").Activate Application.Goto Reference:="R2C35:R200C35" Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False Selection.TextToColumns Destination:=Range("IA2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _ "-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True Range("A2").Select Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\WEEKLY TOTALS NEW") Calculate Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9501.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9502.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9503.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9504.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9505.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9506.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9507.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9508.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9509.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9510.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9511.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9512.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9513.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9514.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9515.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9516.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9517.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9518.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9519.XLS") Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\9520.XLS") Calculate For Each w In Workbooks If w.Name < ThisWorkbook.Name Then w.Close savechanges:=True End If Next w ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\WEEKLY TOTALS NEW") End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
macro to delete entire rows when column A is blank ...a quick macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |