LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 155
Default Save to Desktop, don't overwrite existing

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
ODBC Overwrite existing cells cdobbs Excel Discussion (Misc queries) 0 February 11th 07 05:40 AM
Create a new file, name it and overwrite an existing name without confimation Rob[_5_] Excel Programming 2 January 14th 07 01:31 PM
Overwrite existing file without prompt Tom Ogilvy Excel Programming 0 September 17th 04 01:41 PM
Overwrite existing file without prompt Mark Excel Programming 0 September 17th 04 01:21 PM
Using SaveAs Statement to overwrite existing File Peter Excel Programming 3 June 16th 04 12:27 PM


All times are GMT +1. The time now is 11:33 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"