G
Guest
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
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