Copying Data Between Two Spreadsheets

[Guest]

I need to copy data from spreadsheet “ABC†(not its real name) that’s 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.

 

[Guest]

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

 

[Guest]

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

 

[Guest]

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

 

[Guest]

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

 

[Guest]

Mike,
Your revised code works perfectly! Thanks a million, and thanks for all
your help. I sincerely appreciate it.
Regards, Bob