Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
programmatically save new workbook with custom name & location
Good morning,
The following code works to copy the last submission entered in the "Site Reading Log' to a new workbook. The problem is that this code doesn't name the new workbook. Question: Can this code be modified to: a) save the new workbook as 'Copreco Reading' b) save the new workbook to the users Desktop Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing End Sub -- Carlee |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
programmatically save new workbook with custom name & location
I made some changes to your code that save the new workbook to the current
user's desktop with the name 'Copreco Reading' Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xls" sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub -- urkec "Carlee" wrote: Good morning, The following code works to copy the last submission entered in the "Site Reading Log' to a new workbook. The problem is that this code doesn't name the new workbook. Question: Can this code be modified to: a) save the new workbook as 'Copreco Reading' b) save the new workbook to the users Desktop Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing End Sub -- Carlee |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
programmatically save new workbook with custom name & location
Hi there,
Thanks for the code. I put it into my workbook, but got a Runtime 1004 Error. It states 'the file could not be accessed'. The line in question is: sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ I am working off of Excel 2007; however, this workbook will be implemented on Excel 2003 Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub Here the entire code: -- Carlee "urkec" wrote: I made some changes to your code that save the new workbook to the current user's desktop with the name 'Copreco Reading' Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xls" sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub -- urkec "Carlee" wrote: Good morning, The following code works to copy the last submission entered in the "Site Reading Log' to a new workbook. The problem is that this code doesn't name the new workbook. Question: Can this code be modified to: a) save the new workbook as 'Copreco Reading' b) save the new workbook to the users Desktop Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing End Sub -- Carlee |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
programmatically save new workbook with custom name & location
You can add line to output the file path before SaveAs, tu make sure it is
constructed properly: MsgBox WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx " sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx" -- urkec "Carlee" wrote: Hi there, Thanks for the code. I put it into my workbook, but got a Runtime 1004 Error. It states 'the file could not be accessed'. The line in question is: sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ I am working off of Excel 2007; however, this workbook will be implemented on Excel 2003 Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub Here the entire code: -- Carlee "urkec" wrote: I made some changes to your code that save the new workbook to the current user's desktop with the name 'Copreco Reading' Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xls" sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub -- urkec "Carlee" wrote: Good morning, The following code works to copy the last submission entered in the "Site Reading Log' to a new workbook. The problem is that this code doesn't name the new workbook. Question: Can this code be modified to: a) save the new workbook as 'Copreco Reading' b) save the new workbook to the users Desktop Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing End Sub -- Carlee |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
programmatically save new workbook with custom name & location
thanks to everyone...the problem has been resolved.
-- Carlee "urkec" wrote: You can add line to output the file path before SaveAs, tu make sure it is constructed properly: MsgBox WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx " sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx" -- urkec "Carlee" wrote: Hi there, Thanks for the code. I put it into my workbook, but got a Runtime 1004 Error. It states 'the file could not be accessed'. The line in question is: sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ I am working off of Excel 2007; however, this workbook will be implemented on Excel 2003 Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xlsx """ sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub Here the entire code: -- Carlee "urkec" wrote: I made some changes to your code that save the new workbook to the current user's desktop with the name 'Copreco Reading' Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range Application.ScreenUpdating = False sourceBook = ThisWorkbook.Name 'get the new workbook object Set sbFile = 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing 'get the desktop path, save and close new workbook Set WshShell = CreateObject("WScript.Shell") sbFile.SaveAs Filename:=WshShell.SpecialFolders("Desktop") & "\Copreco Reading.xls" sbFile.Close Set WshShell = Nothing Set sbFile = Nothing End Sub -- urkec "Carlee" wrote: Good morning, The following code works to copy the last submission entered in the "Site Reading Log' to a new workbook. The problem is that this code doesn't name the new workbook. Question: Can this code be modified to: a) save the new workbook as 'Copreco Reading' b) save the new workbook to the users Desktop Sub ExportCoprecoReadingData() Const sourceSheet = "Site Reading Log" ' source Dim sourceBook As String Dim destBook As String Dim sourceRange As Range Dim destRange As Range 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 'change "A" to column with data in last row Range("A" & Rows.Count).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 sourceRange = Nothing Set destRange = Nothing End Sub -- Carlee |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro - save to current location vs excel default location | Excel Discussion (Misc queries) | |||
delete workbook from one location and save workbook to new locatio | Excel Programming | |||
Programmatically Set the Workgroup Templates location | Excel Programming | |||
Macro in Excel 2002 to save a workbook to a FTP location | Excel Discussion (Misc queries) | |||
Programmatically saving a workbook to a ftp location fails | Excel Programming |