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 |
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 |
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 |
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 |
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 |
All times are GMT +1. The time now is 09:51 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com