Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy a range of information to a worksheet in a specific file
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("C12:D16").Select Selection.ClearContents Range("F12:O16").Select Selection.ClearContents Range("C21:D25").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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy a range of information to a worksheet in a specific file
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("C12:D16").Select Selection.ClearContents Range("F12:O16").Select Selection.ClearContents Range("C21:D25").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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy only specific information from one colum to another worksheet | Excel Discussion (Misc queries) | |||
How do I copy specific information from a master sheet? | Excel Worksheet Functions | |||
Copy information down specific cells | Excel Programming | |||
Copy a range from a CSV file in a webpage to my local worksheet | Excel Programming | |||
Copy information from a specific range; not the entire worksheet. | Excel Programming |