|
Copying Data Between Two Spreadsheets
I need to copy data from spreadsheet ABC (not its real name) thats located
on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
Copying Data Between Two Spreadsheets
Bob,
The following code can be run from any worksheet except the file you are reading from and the file you will write to. The originating file will ALWAYS be opened in read-only, and the destination file cannot be open by another user. If it is an error message will display and the copy with cancel. Sub consolidate() Dim origin As String, destin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub destin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If destin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook Workbooks.Open destin, 0, False Set dest = ActiveWorkbook If dest.ReadOnly Then MsgBox ("The destination file is in use and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=dest.Sheets("Consolidated Data").Range("A2") dest.Save inuse: orgn.Close dest.Close Application.ScreenUpdating = True End Sub Good luck! Let me know if there's anything more I can help with. Mike "Bob" wrote: I need to copy data from spreadsheet ABC (not its real name) thats located on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
Copying Data Between Two Spreadsheets
Mike,
Thanks for your help! I sincerely appreciate it. I was hoping to run the macro from within the destination spreadsheet, rather than running it from a third spreadsheet. Is there any way to modify your code to accomplish my original objective? Thanks again, Bob "crazybass2" wrote: Bob, The following code can be run from any worksheet except the file you are reading from and the file you will write to. The originating file will ALWAYS be opened in read-only, and the destination file cannot be open by another user. If it is an error message will display and the copy with cancel. Sub consolidate() Dim origin As String, destin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub destin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If destin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook Workbooks.Open destin, 0, False Set dest = ActiveWorkbook If dest.ReadOnly Then MsgBox ("The destination file is in use and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=dest.Sheets("Consolidated Data").Range("A2") dest.Save inuse: orgn.Close dest.Close Application.ScreenUpdating = True End Sub Good luck! Let me know if there's anything more I can help with. Mike "Bob" wrote: I need to copy data from spreadsheet ABC (not its real name) thats located on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
Copying Data Between Two Spreadsheets
Mike,
One more thing, it looks like your code is testing to see if the destination spreadsheet is in use. The test should be for the originating spreadsheet since it is the one located on a shared drive, whereas the destination spreadsheet will always be located on my local hard drive. Thanks, Bob "crazybass2" wrote: Bob, The following code can be run from any worksheet except the file you are reading from and the file you will write to. The originating file will ALWAYS be opened in read-only, and the destination file cannot be open by another user. If it is an error message will display and the copy with cancel. Sub consolidate() Dim origin As String, destin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub destin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If destin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook Workbooks.Open destin, 0, False Set dest = ActiveWorkbook If dest.ReadOnly Then MsgBox ("The destination file is in use and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=dest.Sheets("Consolidated Data").Range("A2") dest.Save inuse: orgn.Close dest.Close Application.ScreenUpdating = True End Sub Good luck! Let me know if there's anything more I can help with. Mike "Bob" wrote: I need to copy data from spreadsheet ABC (not its real name) thats located on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
Copying Data Between Two Spreadsheets
Bob,
Here is the revised code. I don't check if the origin workbook is in use because the code ALWAYS opens the file in Read-Only mode. The only reason I check the destination workbook is to ensure that file has not been opened in readonly mode. The following code will copy the cells from the selected origin file to the sheet "Consolidated Data" in the workbook the code module is in. Sub consolidate() Dim origin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook If ThisWorkbook.ReadOnly Then MsgBox ("The destination file has been opened as a Read-Only file and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=ThisWorkbook.Sheets("Consolidated Data").Range("A2") ThisWorkbook.Save inuse: orgn.Close Application.ScreenUpdating = True End Sub Mike "Bob" wrote: Mike, One more thing, it looks like your code is testing to see if the destination spreadsheet is in use. The test should be for the originating spreadsheet since it is the one located on a shared drive, whereas the destination spreadsheet will always be located on my local hard drive. Thanks, Bob "crazybass2" wrote: Bob, The following code can be run from any worksheet except the file you are reading from and the file you will write to. The originating file will ALWAYS be opened in read-only, and the destination file cannot be open by another user. If it is an error message will display and the copy with cancel. Sub consolidate() Dim origin As String, destin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub destin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If destin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook Workbooks.Open destin, 0, False Set dest = ActiveWorkbook If dest.ReadOnly Then MsgBox ("The destination file is in use and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=dest.Sheets("Consolidated Data").Range("A2") dest.Save inuse: orgn.Close dest.Close Application.ScreenUpdating = True End Sub Good luck! Let me know if there's anything more I can help with. Mike "Bob" wrote: I need to copy data from spreadsheet ABC (not its real name) thats located on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
Copying Data Between Two Spreadsheets
Mike,
Your revised code works perfectly! Thanks a million, and thanks for all your help. I sincerely appreciate it. Regards, Bob "crazybass2" wrote: Bob, Here is the revised code. I don't check if the origin workbook is in use because the code ALWAYS opens the file in Read-Only mode. The only reason I check the destination workbook is to ensure that file has not been opened in readonly mode. The following code will copy the cells from the selected origin file to the sheet "Consolidated Data" in the workbook the code module is in. Sub consolidate() Dim origin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook If ThisWorkbook.ReadOnly Then MsgBox ("The destination file has been opened as a Read-Only file and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=ThisWorkbook.Sheets("Consolidated Data").Range("A2") ThisWorkbook.Save inuse: orgn.Close Application.ScreenUpdating = True End Sub Mike "Bob" wrote: Mike, One more thing, it looks like your code is testing to see if the destination spreadsheet is in use. The test should be for the originating spreadsheet since it is the one located on a shared drive, whereas the destination spreadsheet will always be located on my local hard drive. Thanks, Bob "crazybass2" wrote: Bob, The following code can be run from any worksheet except the file you are reading from and the file you will write to. The originating file will ALWAYS be opened in read-only, and the destination file cannot be open by another user. If it is an error message will display and the copy with cancel. Sub consolidate() Dim origin As String, destin As String Dim orgn As Workbook, dest As Workbook Application.ScreenUpdating = False origin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If origin = "False" Then Exit Sub destin = Application.GetOpenFilename("Microsoft Office Excel Files (*.xl*;*.xls;*.xla;*.xlm;*.xlc;*.xlw),*.xl*;*.xls; *.xla;*.xlm;*.xlc;*.xlw") If destin = "False" Then Exit Sub Workbooks.Open origin, 0, True Set orgn = ActiveWorkbook Workbooks.Open destin, 0, False Set dest = ActiveWorkbook If dest.ReadOnly Then MsgBox ("The destination file is in use and cannot be written to...Cancelling") GoTo inuse End If orgn.Sheets("Detail Data").Range("H6:H990").Copy _ Destination:=dest.Sheets("Consolidated Data").Range("A2") dest.Save inuse: orgn.Close dest.Close Application.ScreenUpdating = True End Sub Good luck! Let me know if there's anything more I can help with. Mike "Bob" wrote: I need to copy data from spreadsheet ABC (not its real name) thats located on a shared drive, to spreadsheet XYZ (also not its real name) located on my local hard drive. The range of cells to be copied from ABC will always be Detail Data!H6:H990. The destination starting cell will always be Consolidated Data!A2. The macro would need to prompt the user for both the originating and destination locations (using Windows standard File | Open dialog box). Since ABC is located on a shared drive, there may be times when ABC is in use by another user and therefore locked, except for read-only capabilities. Consequently, the macro would also need to check for that condition, and if it exists, automatically select the read-only option. Being new to VBA, I would greatly appreciate any help in writing the aforementioned macro, especially since two spreadsheets are involved. Thanks. |
| All times are GMT +1. The time now is 09:08 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com