ROBINSYN
Board Regular
- Joined
- Aug 19, 2002
- Messages
- 188
Is there any reason this would not work in excel 97 under a Mac system.
Sub savecopy()
'
' savecopy Macro
' Macro recorded 10/24/2002 by Cindy Robinson
'FindLastRow()
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
Sheets("Purchase Order").Select
Range("K8").Select
ActiveCell.FormulaR1C1 = "=MAX(c[15])+1"
Sheets("Summary").Range("A65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k8")
Sheets("Summary").Range("B65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("g9")
Sheets("Summary").Range("C65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C48")
Sheets("Summary").Range("D65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h48")
Sheets("Summary").Range("E65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k48")
Sheets("Summary").Range("G65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C49")
Sheets("Summary").Range("H65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h49")
Sheets("Summary").Range("I65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k49")
Sheets("Summary").Range("K65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C50")
Sheets("Summary").Range("L65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h50")
Sheets("Summary").Range("M65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k50")
Sheets("Summary").Range("O65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k52")
Sheets("Purchase Order").Range("z65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k8")
Sheets("Purchase Order").copy
Range("A2:Q60").Select
Selection.copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K8").Select
ActiveCell.FormulaR1C1 = "=MAX(c[15])"
Rows("1:1").Select
Selection.RowHeight = 4.5
ActiveSheet.Shapes.SelectAll
Selection.Cut
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
Sheets("Purchase Order").Select
Range("B2:l60").Select
ActiveSheet.PageSetup.PrintArea = "$B$2:$l$60"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False
Dim Path As String ' path of current worksheet
Dim ThisFileNew As String ' new file name including path
Dim Resp As Integer ' user response to overwrite query
Dim i As Integer ' rename workSHEETS
Target = Range("Q1")
' Get current path (empty if workbook has never been saved)
Path = ThisWorkbook.Path
If Not Path = "" Then Path = Path & ""
ThisFileNew = Path & Target & " .xls"
Resp = vbOK
' Check for existing file of same name and, if present, ask whether to overwrite
If Dir(ThisWorkbook.Path & "" & Target & " .xls")<> "" Then
Resp = MsgBox("This file already exists. Overwrite? ", vbExclamation + vbOKCancel)
End If
' Save the workbook if file does not exist, or if user wants to overwrite it
If Resp = vbOK Then
ActiveWorkbook.SaveAs Filename:=ThisFileNew
Else
Resp = MsgBox("You will need to rename this file manually", vbInformation)
End If
ActiveWorkbook.Close
Range("D26:J43").Select
Selection.ClearContents
Range("K48:K50").Select
Selection.ClearContents
Range("J12:K12").Select
Selection.ClearContents
Range("I23:K23").Select
Selection.ClearContents
Range("J12:K12").Select
Range("J26").Select
ActiveCell.FormulaR1C1 = "0"
Range("J26").Select
Selection.copy
Range("J27:J43").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K48:K50").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K8").Select
Selection.ClearContents
Range("G8").Select
End Sub
This message was edited by ROBINSYN on 2002-11-02 11:31
Sub savecopy()
'
' savecopy Macro
' Macro recorded 10/24/2002 by Cindy Robinson
'FindLastRow()
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
Sheets("Purchase Order").Select
Range("K8").Select
ActiveCell.FormulaR1C1 = "=MAX(c[15])+1"
Sheets("Summary").Range("A65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k8")
Sheets("Summary").Range("B65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("g9")
Sheets("Summary").Range("C65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C48")
Sheets("Summary").Range("D65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h48")
Sheets("Summary").Range("E65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k48")
Sheets("Summary").Range("G65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C49")
Sheets("Summary").Range("H65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h49")
Sheets("Summary").Range("I65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k49")
Sheets("Summary").Range("K65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("C50")
Sheets("Summary").Range("L65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("h50")
Sheets("Summary").Range("M65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k50")
Sheets("Summary").Range("O65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k52")
Sheets("Purchase Order").Range("z65536").End(xlUp).Offset(1, 0) = Sheets("Purchase Order").Range("k8")
Sheets("Purchase Order").copy
Range("A2:Q60").Select
Selection.copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K8").Select
ActiveCell.FormulaR1C1 = "=MAX(c[15])"
Rows("1:1").Select
Selection.RowHeight = 4.5
ActiveSheet.Shapes.SelectAll
Selection.Cut
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
Sheets("Purchase Order").Select
Range("B2:l60").Select
ActiveSheet.PageSetup.PrintArea = "$B$2:$l$60"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False
Dim Path As String ' path of current worksheet
Dim ThisFileNew As String ' new file name including path
Dim Resp As Integer ' user response to overwrite query
Dim i As Integer ' rename workSHEETS
Target = Range("Q1")
' Get current path (empty if workbook has never been saved)
Path = ThisWorkbook.Path
If Not Path = "" Then Path = Path & ""
ThisFileNew = Path & Target & " .xls"
Resp = vbOK
' Check for existing file of same name and, if present, ask whether to overwrite
If Dir(ThisWorkbook.Path & "" & Target & " .xls")<> "" Then
Resp = MsgBox("This file already exists. Overwrite? ", vbExclamation + vbOKCancel)
End If
' Save the workbook if file does not exist, or if user wants to overwrite it
If Resp = vbOK Then
ActiveWorkbook.SaveAs Filename:=ThisFileNew
Else
Resp = MsgBox("You will need to rename this file manually", vbInformation)
End If
ActiveWorkbook.Close
Range("D26:J43").Select
Selection.ClearContents
Range("K48:K50").Select
Selection.ClearContents
Range("J12:K12").Select
Selection.ClearContents
Range("I23:K23").Select
Selection.ClearContents
Range("J12:K12").Select
Range("J26").Select
ActiveCell.FormulaR1C1 = "0"
Range("J26").Select
Selection.copy
Range("J27:J43").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K48:K50").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K8").Select
Selection.ClearContents
Range("G8").Select
End Sub
This message was edited by ROBINSYN on 2002-11-02 11:31