Below is some code that was created with the help of this sight as well as
some reference books. The code works wonders for what I want it to do but I
would like to improve upon it. Currently I print my worksheet, Copy it to a
new worksheet, Save the Work Sheet use a cell location for the name of the
file, and then it clears the worksheet. What I would like to improve with
this code would be to have it copy the information to another file located in
another directory (example C:\"Original Directory" to c:\"New Directory"
Could someone offer me a suggestion as to how to accomplish this. The code is
posted below. Thanks
Sub All_in_One()

' Prints the Time Sheet
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

' Copies the Time Sheet to the Time Record Tab
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng1 As Range, rng2 As Range
Set sh1 = Worksheets("Time Sheet")
Set sh2 = Worksheets("Time Record")
Set rng1 = sh1.Range("a11:AE26")
Set rng2 = GetRealLastCell(sh2)
Set rng2 = sh2.Cells(rng2.Row + 1, 1)
rng1.Copy
rng2.PasteSpecial xlValues

' Clears the Time Sheet
Range("C1216").Select
Selection.ClearContents
Range("F12:O16").Select
Selection.ClearContents
Range("C2125").Select
Selection.ClearContents
Range("F21:O25").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-9
Range("F1").Select

' Saves the Time Sheet to a new File Naming it by the Employees Name

Dim CurrentWorkbook As Workbook
Dim NewWorkbook As Workbook
Dim Rng As Range

Set CurrentWorkbook = ActiveWorkbook
Set NewWorkbook = Workbooks.Open(Filename:="Time.xls")
CurrentWorkbook.Sheets(Array("Time Sheet")).Copy
after:=NewWorkbook.Worksheets(1)
Set Rng = Sheets("Time Sheet").Range("b5")
ActiveWorkbook.SaveAs _
Filename:=Rng.Value & ".xls", _
FileFormat:=xlWorkbookNormal
NewWorkbook.Close savechanges:=False
CurrentWorkbook.Close savechanges:=False





End Sub

Public Function GetRealLastCell(sh As Worksheet) As Range
Dim RealLastRow As Long
Dim RealLastColumn As Long
On Error Resume Next
RealLastRow = _
sh.Cells.Find("*", sh.Range("a1"), , , xlByRows, xlPrevious).Row
RealLastColumn = _
sh.Cells.Find("*", sh.Range("a1"), , , xlByColumns, xlPrevious).Column
If RealLastRow < 1 Then RealLastRow = 1
If RealLastColumn < 1 Then RealLastColumn = 1
Set GetRealLastCell = sh.Cells(RealLastRow, RealLastColumn)
End Function

ActiveWorkbook.SaveAs _
Filename:=Rng.Value & ".xls", _
FileFormat:=xlWorkbookNormal

would become

newWorkbook.SaveAs _
Filename:="C:\New Directory\" &Rng.Value & ".xls", _
FileFormat:=xlWorkbookNormal


assuming "C:\New Directory" already exists.

--
Regards,
Tom Ogilvy

"Theo Degr" wrote:

> Below is some code that was created with the help of this sight as well as
> some reference books. The code works wonders for what I want it to do but I
> would like to improve upon it. Currently I print my worksheet, Copy it to a
> new worksheet, Save the Work Sheet use a cell location for the name of the
> file, and then it clears the worksheet. What I would like to improve with
> this code would be to have it copy the information to another file located in
> another directory (example C:\"Original Directory" to c:\"New Directory"
> Could someone offer me a suggestion as to how to accomplish this. The code is
> posted below. Thanks
> Sub All_in_One()
>
> ' Prints the Time Sheet
> ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
>
> ' Copies the Time Sheet to the Time Record Tab
> Dim sh1 As Worksheet, sh2 As Worksheet
> Dim rng1 As Range, rng2 As Range
> Set sh1 = Worksheets("Time Sheet")
> Set sh2 = Worksheets("Time Record")
> Set rng1 = sh1.Range("a11:AE26")
> Set rng2 = GetRealLastCell(sh2)
> Set rng2 = sh2.Cells(rng2.Row + 1, 1)
> rng1.Copy
> rng2.PasteSpecial xlValues
>
> ' Clears the Time Sheet
> Range("C1216").Select
> Selection.ClearContents
> Range("F12:O16").Select
> Selection.ClearContents
> Range("C2125").Select
> Selection.ClearContents
> Range("F21:O25").Select
> Selection.ClearContents
> ActiveWindow.SmallScroll Down:=-9
> Range("F1").Select
>
> ' Saves the Time Sheet to a new File Naming it by the Employees Name
>
> Dim CurrentWorkbook As Workbook
> Dim NewWorkbook As Workbook
> Dim Rng As Range
>
> Set CurrentWorkbook = ActiveWorkbook
> Set NewWorkbook = Workbooks.Open(Filename:="Time.xls")
> CurrentWorkbook.Sheets(Array("Time Sheet")).Copy
> after:=NewWorkbook.Worksheets(1)
> Set Rng = Sheets("Time Sheet").Range("b5")
> ActiveWorkbook.SaveAs _
> Filename:=Rng.Value & ".xls", _
> FileFormat:=xlWorkbookNormal
> NewWorkbook.Close savechanges:=False
> CurrentWorkbook.Close savechanges:=False
>
>
>
>
>
> End Sub
>
> Public Function GetRealLastCell(sh As Worksheet) As Range
> Dim RealLastRow As Long
> Dim RealLastColumn As Long
> On Error Resume Next
> RealLastRow = _
> sh.Cells.Find("*", sh.Range("a1"), , , xlByRows, xlPrevious).Row
> RealLastColumn = _
> sh.Cells.Find("*", sh.Range("a1"), , , xlByColumns, xlPrevious).Column
> If RealLastRow < 1 Then RealLastRow = 1
> If RealLastColumn < 1 Then RealLastColumn = 1
> Set GetRealLastCell = sh.Cells(RealLastRow, RealLastColumn)
> End Function
>
>