Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I am using the below code to export the last row in the 'Site Reading Log' to
a new workbook on the desktop, named 'Copreco Daily Reading Submission'. It works great, it overwrites the last file exported to the desktop, of the same name. Where is what i need this code to do: 1) export the last row of the Site Reading Log to a new workbook called 'Copreco Daily Submission" 2) save the new worksheet to the users desktop 3). if a file of the same name exists, allow the user to rename the sheet, so as not to overwrite the existing one. Sub ExportCoprecoReadingData() 'these have to do with THIS workbook 'name of the sheet to get data from Const sourceSheet = "Site Reading Log" 'column that always have value in it in last row Const sourceKeyColumn = "A" '**** 'This is the name you want to give to the 'NEW workbook created each time to put new data 'into as set up this code will overwrite any 'existing file of this name without any warning. Const newWorkbookName = "Copreco Daily Reading Submission.xls" '**** Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Dim MaxLastRow As Long Dim pathToUserDesktop As String 'determine last possible row number 'based on version of Excel in use If Val(Left(Application.Version, 2)) < 12 Then 'we are in pre-Excel 2007 version MaxLastRow = Rows.Count Else 'are in Excel 2007 (or later?) MaxLastRow = Rows.CountLarge End If 'keeps screen from flickering 'speeds things up also Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name Workbooks.Add ' create new book destBook = ActiveWorkbook.Name Windows(sourceBook).Activate Worksheets(sourceSheet).Select Set sourceRange = ActiveSheet.Rows("1:1") Set destRange = Workbooks(destBook).Worksheets( _ "Sheet1").Rows("1:1") destRange.Value = sourceRange.Value Range(sourceKeyColumn & MaxLastRow).End(xlUp).Select Set sourceRange = ActiveSheet.Rows( _ ActiveCell.Row & ":" & ActiveCell.Row) Set destRange = Workbooks(destBook).Worksheets( _ "Sheet1").Rows("2:2") destRange.Value = sourceRange.Value Set destRange = Nothing Set sourceRange = Nothing 'build up the path to the user's desktop 'based on standard paths and Windows standards 'path is normally ' C:\Documents and Settings\username\Desktop 'our task is to determine the 'username' portion 'which is the Windows username (login name) which 'may be different than the Excel UserName pathToUserDesktop = "C:\Documents and Settings\" & _ Get_Win_User_Name() & "\Desktop\" & newWorkbookName 'save new workbook, but don't nag 'user with "file exists" message Application.DisplayAlerts = False With Workbooks(destBook) 'renames it while saving it 'will overwrite existing file of same name .SaveAs newWorkbookName 'close it .Close End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub -- Carlee |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
ODBC Overwrite existing cells | Excel Discussion (Misc queries) | |||
Create a new file, name it and overwrite an existing name without confimation | Excel Programming | |||
Overwrite existing file without prompt | Excel Programming | |||
Overwrite existing file without prompt | Excel Programming | |||
Using SaveAs Statement to overwrite existing File | Excel Programming |