PDA

View Full Version : Solved: Copy & Paste data between 2 workbooks



jpirhalla
02-14-2009, 07:21 AM
Hello, I would like to create two VBA macros for Excel that accomplish the following:
(1) open "Master" workbook, prompt to open a "Rep" workbook, then copy & paste 4 sheets from Rep wb and replace the corresponding sheets in Master wb.
(2) Add a function that renders the workbook useless after a certain time frame.
Any suggestions?

GTO
02-14-2009, 12:02 PM
Greetings,

Okay - maybe it's just me, but your request seems a wee bit unclear.

'open "Master" workbook...' - is "Master.xls" the name of the wb? Is it in the same folder as the wb we're writing the code in?

'...prompt to open a "Rep" workbook,...' - What are we prompting the user for: whether to proceed, or are we giving the user some type of choice as to what wb will be opened/extracted from?

'...then copy & paste 4 sheets...' - Give us a hint here, do the sheets have names?

'...Add a function that renders the workbook useless...' - Far as I can tell, we have three workbooks. Which one is this referring to?

Now more importantly, I see you just joined :-) In my opinion, you have joined the best forum around. You will meet some great folks here, who will go out of their way to be helpful. I certainly hope you don't get discouraged at my questions, as my intent is to be helpful, and I think with some additional details/clarity in the request, you'll get a great solution.

Hope this helps,

Mark

jpirhalla
02-14-2009, 12:12 PM
Thanks Mark. Please see below.
'open "Master" workbook...' - is "Master.xls" the name of the wb? Is it in the same folder as the wb we're writing the code in? **Master.xlsm is the name of the workbook. It typically does not reside in the same folder as Rep.xls (master is the wb that receives the info form rep)

'...prompt to open a "Rep" workbook,...' - What are we prompting the user for: whether to proceed, or are we giving the user some type of choice as to what wb will be opened/extracted from? **allows the user to select a workbook; the example here is named rep.xls.

'...then copy & paste 4 sheets...' - Give us a hint here, do the sheets have names? ** sheet names are "Summary", "Proposal", "Analysis" and "Investor Summary" - these worksheets are named identically in all rep worksheets and master.

'...Add a function that renders the workbook useless...' - Far as I can tell, we have three workbooks. Which one is this referring to? ** there are two workbooks (rep.xls <this name will always be different> and master.xlsm. The wb that needs to expire is rep.xls.

Thanks!

stanleydgrom
02-14-2009, 12:13 PM
jpirhalla,


(2) Add a function that renders the workbook useless after a certain time frame.

Try:
Deleteing a file in VBA, by Tom Urtis
http://www.mrexcel.com/forum/showthread.php?t=48867

By Justinlabenne
http://www.vbaexpress.com/forum/showthread.php?t=3923

Excel Frequently Asked Questions, Ozgrid.com



Sub DeleteThisModule() Dim vbCom As Object MsgBox "Hi, I will delete myself " Set vbCom = Application.VBE.ActiveVBProject.VBComponents vbCom.Remove VBComponent:= _ vbCom.Item("Module1")End Sub




You can also, after a certain date, do a file save as "Read Only" - but I can not find it in my archives.


Have a great day,
Stan

GTO
02-14-2009, 06:34 PM
Greetings,

Please note that I wrote the file filtering for xl2003 and before. I think that FileFilter:="Microsoft Office Excel Workbook(*.xls; *.xlsm), *.xls; *.xlsm" would also display 2007 files, but cannot test, so didn't include.

I would note that you may wish to save a copy of master.xlsm as master.xls (ie - earlier format) until you're sure you have no more questions, as there's still plenty of us who don't have 2007, and thus cannot open any attachment...


Anyways, in a Standard Module:
Option Explicit

Public Sub Sheets_Import()
Dim _
wbSource As Workbook, _
wksSource As Worksheet, _
wksDest As Worksheet, _
bytSheet As Byte, _
intIndex As Integer, _
strSourceWB As String, _
aSheets() As Variant

'// Assign the return string from PickFile() //
strSourceWB = PickFile

If Not strSourceWB = "False" _
And Not strSourceWB = ThisWorkbook.FullName Then

'// User picked a 'good' wb, so kill screen updating and calculating for the //
'// moment. //
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'// Set a reference to the wb the user chose...//
Set wbSource = Workbooks.Open(Filename:=strSourceWB, _
ReadOnly:=True, _
AddToMru:=False)
Else
'// ...or exit if they cancelled or chose this workbook. //
Exit Sub
End If

'// Assign array of sheets we want to copy. If you add a sheet later, you need to //
'// change: For bytSheet = 0 To 4. //

ReDim aSheets(0 To 3)
aSheets() = Array("Summary", "Proposal", "Analysis", "Investor Summary")


'// Loop for as many sheets as we're "importing". //
For bytSheet = 0 To 3

'// Clear any errors. //
Err.Clear

'// Temporarily handle errors in-line. //
On Error Resume Next

'// Set a reference to the next worksheet to be imported...//
Set wksSource = wbSource.Worksheets(aSheets(bytSheet))

'// ...If there is no error, then the source wb contains the sheet... //
If Not Err.Number > 0 Then
'//...So then see if we have a sheet to overwrite... //
Set wksDest = ThisWorkbook.Worksheets(aSheets(bytSheet))
'// If no error now, we have a sheet to "overwrite", so... //
If Not Err.Number > 0 Then
'// ...get its Index and delete the old sheet... //
intIndex = wksDest.Index
Application.DisplayAlerts = False
wksDest.Delete
Application.DisplayAlerts = True
Else
'//...elswise, assign 1. //
intIndex = 1
End If

'// Now copy source wb sheet to destination wb, placing it in the same //
'// order as the old sheet, or, if no old sheet, at front (leftmost tab) of //
'// sheets. //
wksSource.Copy Before:=ThisWorkbook.Sheets(intIndex)

'// Else - Nothing. If the first IF found an error, then there's a missing //
'// sheet in source wb, so skip to next loop. //
End If
Next


'// Clear any remaining error. //
Err.Clear

'// Close source wb. //
wbSource.Close SaveChanges:=False

'// Turn stuff back on. //
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function PickFile() As String
Const Dialog_Title As String = "Pick a file to import sheets from"

If Not Left(CurDir(), 1) = Left(ThisWorkbook.Path, 1) Then
ChDrive Left(ThisWorkbook.Path, 1)
End If

ChDir ThisWorkbook.Path & Application.PathSeparator

PickFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Office Excel Workbook(*.xls), *.xls", _
Title:=Dialog_Title, _
MultiSelect:=False)
End Function
Hope this helps,

Mark

jpirhalla
02-14-2009, 09:23 PM
Mark,
Thanks for the assistance. My concern is pertaining to the following:

If Not Err.Number > 0 Then
'// ...get its Index and delete the old sheet... //
intIndex = wksDest.Index
Application.DisplayAlerts = False
wksDest.Delete
Application.DisplayAlerts = True
Else

If the old sheet in Master.xls is deleted before the new sheet from Rep is pasted, then won't the references from other sheets in Master.xls that reference the sheets to be replaced return a #REF! is the sheet is deleted and then replaced? If so, then is there a way to replace the contents of each sheet without deleting it? That way the existing references throughout Master.xls will remain intact?

jpirhalla
02-14-2009, 09:46 PM
With regards to expiring the workbook on a certain date - I do not want to delete the workbook. I would like include the following functionality:
1. on a certain date, prompt the user for a password.
2. if the password is incorrect, hide all sheets except a blank sheet and save without without asking. So the next time the user opens the workbook he only sees the blank sheet and cannot unhide the other sheets. If the password is correct, End Sub.
3. I can then protect the VBA code so the user needs a password to access the code to unhide the hidden sheets.

GTO
02-15-2009, 12:10 AM
Greetings j,

Reference your last at #6, yes, if there are dependent cells, the formulas will be goobered up.


then copy & paste 4 sheets from Rep wb and replace the corresponding sheets in Master wb...

I am afraid the replacing the corresponding sheets part threw me a bit.

If I didn't mention it already, of course try this first in a copy of your wb, in case anything else is overlooked. Let's try this, to copy all the cells from ea source sheet.

Option Explicit
Public Sub Sheets_CopyAll()
Dim _
wbSource As Workbook, _
wksSource As Worksheet, _
wksDest As Worksheet, _
bytSheet As Byte, _
strSourceWB As String, _
aSheets() As Variant

'// Assign the return string from PickFile() //
strSourceWB = PickFile


If Not strSourceWB = "False" _
And Not strSourceWB = ThisWorkbook.FullName Then

'// User picked a 'good' wb, so kill screen updating and calculating for the //
'// moment. //
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'// Set a reference to the wb the user chose...//
Set wbSource = Workbooks.Open(Filename:=strSourceWB, _
ReadOnly:=True, _
AddToMru:=False)
Else
'// ...or exit if they cancelled or chose this workbook. //
Exit Sub
End If


'// Assign array of sheets we want to copy. If you add a sheet later, you need tp //
'// change For bytSheet = 0 to 4. //

ReDim aSheets(0 To 3)
aSheets() = Array("Summary", "Proposal", "Analysis", "Investor Summary")


'// Loop for as many sheets as we're "importing". //
For bytSheet = 0 To 3


'// Clear any errors. //
Err.Clear

'// Temporarily handle errors in-line. //
On Error Resume Next


'// Set a reference to the next worksheet to be imported...//
Set wksSource = wbSource.Worksheets(aSheets(bytSheet))


'// ...If there is no error, then the source wb contains the sheet... //
If Not Err.Number > 0 Then
'//...So then see if we have a sheet to overwrite... //
Set wksDest = ThisWorkbook.Worksheets(aSheets(bytSheet))
'// If no error now, we have a sheet to "overwrite", so... //
If Not Err.Number > 0 Then
'//***COPY all the cells on the Source sheet to the Destination sheet. //
wksSource.Cells.Copy Destination:=wksDest.Cells
Else
'// If no sheet ("Summary" for instance) in the Destination wb //
'// (ThisWorkbook), import a copy of the sheet. //
wksSource.Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next


'// Clear any remaining error. //
Err.Clear


'// Close source wb. //
wbSource.Close SaveChanges:=False


'// Turn stuff back on. //
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

As to the disabling the source wb's after a certain amount of time, while I understand that the KB currently has issues, if you read carefully thru what Stan offered, you would see that brettdj's article references johnske's article on setting a trial period.

Workbook Suicide brettdj http://www.vbaexpress.com/kb/getarticle.php?kb_id=540

Set a Trial Period johnske http://www.vbaexpress.com/kb/getarticle.php?kb_id=475

As to effectively using this, several issues had already made me decide not to tackle this, namely: If the users are compliant, there's no need. If they are not compliant, the "expiring" wb's will need to effectively force enabling of macros.

Then non-compliant users will just copy the sheets to a new uncoded wb.

To battle that, you get to write a decent amount of code hiding/disabling commandbars (toolbars). Then you'll find out how many shortcut key combos there are that you never knew about...

In short, only my opinion, but a lot of work vs. just having whoever is using the master not select wb's over so old... If it still sounds like a ton o' fun though, here's a wb attached showing what seems to be a reliable manner of forcing enabling of macros.

Mark

jpirhalla
02-15-2009, 10:48 AM
GTO,
Your code looks great. But for some reason it causes Excel to hang (have to go into Task Mgr to End). Thoughts?

jpirhalla
02-15-2009, 11:32 AM
Can your code be modified to something similar to function below for each sheet so that I can step into it to find where it's hanging?

Windows("Rep.xls").Activate
Sheets("Submission Form").Select
Cells.Select
Range("B1").Activate
Selection.Copy

Windows("Master.xlsm").Activate
Sheets("Submission Form").Select
Cells.Select
ActiveSheet.Paste

jpirhalla
02-15-2009, 11:58 AM
Mark,

Regarding the ForceEnable issue, how may I ensure that only sheets "Submission", "Rent" and "Analysis" are visible if macros are enabled and the remaining sheets in hte workbook remain hidden?

For Each wksWorksheet In ThisWorkbook.Worksheets
If Not wksWorksheet.CodeName = "shtForceEnable" Then
wksWorksheet.Visible = xlSheetVeryHidden
End If
Next

GTO
02-15-2009, 02:58 PM
GTO,
Your code looks great. But for some reason it causes Excel to hang (have to go into Task Mgr to End). Thoughts?

j,

I am unable to replicate any hangs, and cannot see what would cause it. Of course we cannot see any mods or parameters of your workbook(s) that I haven't thought of (and believe me, there's plenty I forget).

So... after taking out any private/sensitive data, post a copy of what you have so far. That is, a copy of master.xls, as well as an example of a Rep wb. When posting attachments, there is a one attachment per post limitation; but you can put both wb's in a zip file and get it attached to one post that way.

After you zip the workbooks, press the Go Advanced button, and you will see Additional Options below the window you type in. In Additional Options, press the Manage Attachments button, it is self-explanatory therafter.

Reminder: remember to saveas the workbook examples in pre-2007 format.

Mark

jpirhalla
02-15-2009, 07:20 PM
Mark,
Sorry for not being more thorough... it appears there may be an issue if the sheets in Rep are protected. Once I unprotected all sheets, it worked fine. Awesome! Many thanks!

GTO
02-16-2009, 04:24 AM
Hi j,

Happy to help and glad it worked out. If solved, you can mark it as such by clicking on Thread Tools right above your first post. This saves members time in not checking stuff that's already resolved.

Thanks,

Mark

Mark

jpirhalla
02-16-2009, 08:31 AM
Solved. Any additional thoughts on the ForceEnable issue? How may I ensure that only sheets "Submission", "Rent" and "Analysis" are visible if macros are enabled and the remaining sheets in hte workbook remain hidden?