Solved: need to copy data from one workbook to another on selected cells

Need to copy data from one workbook to another on selected cells

'I want to create the macro with the following:
'1. Click Run
'2. user gets a prompt to select excel files to be processed
'3. User selects multiple files to be processed
'4. The macro shall copy and paste the data into a destination template and then save the file same as cell B3 in source file. There shall be a separate file created and saved for each source file.
'5. The data that needs to be copied from each worksheet is listed under Run button on Test
'6. The macro shall create a file for each file selected and then save it into a defined path. We can go with C:\.

Test1 - excel macro is stored, Test2 - source excel, Test 3 Destination excel.

'I have included Test1, Test2 and Test3.
'Can anyone please help ? i started working on it, but do not know how to go further as i keep getting error message 'on selecting files. And i deleted the code after that. And i have multiple of these source files that i want to process.

Re your point 5, will the data always be the same, or do you want to be able to add to or change the ranges on the worksheet and have the code pick it up? (Basically I want to know if we can hardcode the data into the code). Also, does the picture box in the source workbook always have the same name, or is it the only picture, or do we have to use the location of it?

We need to capture the data in cells for point 5 as described in file Test1 under Run button on the attached file. I have multiple source files that will create same number of destination files at predefined location. So, code should pick it up, i think.

Picture- location is better. As i might have upto 6 pics in one worksheet. Thanks for your help. Hopefully this clarified.

The data shall be captured in the set template (Test3 in attached file)

Hi Rory
There are whole bunch of other cells that need to be copied. Once i have the base code, i will make those changes myself. I did not mention that huge list. And gave a few cells so as to get a base code. So, it cannot be hard coded. We need code 2 pick it up.
Thanks

http://www.tek-tips.com/viewthread.c...1424408&page=1

Hi i posted here also, but no response at all. Can you please help???Greatly appreciated.

Will the additional ranges to be copied be laid out in the same way, or will they form a named range that can be used to determine where to get the information from?
(PS Please bear in mind that I am not in the same time zone as you! :) )

Thats ok..your help is greatly appreciated.

They will be all part of the template. We are going to leave the named ranges untouched as in the template or in the source file. We only want to copy some cells to another template and then save the template. I have 100 source files. So, i will create 100 destination file programmatically. I will keep the template intact though.

i meant we only want to copy the values in some cells from source to destination files.
I hope this clarified

I got that. My point was that you have some cells in the Test1 workbook that determine which cells get copied from the source workbook to which cells in the template. Are you planning to name the cells in Test1 so that the code can just loop through all the cells in the named range to determine all the cells it needs to copy? It's not important just now, but I thought I'd ask so it can be incorporated at the outset.

No, we are not going to give them any names. This is the source file that we are using. No changes to be done.

Hi
Just to clarify, In the attached zip file:
Test1---Will store the macro
Test2---Source File (may or may not be multiple source files)
Test3---Destination template (number of destination files shall be same as source files)

This should get you started. I changed the layout of your copy/paste table to make life easier.

Thanks Rory for your help. Greatly appreciated. I will make changes that i need. Will let you know if i need your help again. Thanks once again. Where are you in Scotland? I live in Dallas, Texas, USA.

Hi "Rory"
I am a beginner at VBA. Please let me know:
The code breaks down at " Set wksSource = mwbInvoice.Worksheets(rngCell.Value)" . Get Run Time error 9, subscript out of range. It lets me select the input files and when I select them, I get this run time error. If you have to change mwbInvoice to anything, feel free. I was trying to put code together, it was not working anyways.
For all cells that I need copied and pasted, I can list them on the external macro sheet. (Test1). ????
Thanks for your help and patience.

That means that there is no worksheet in the selected workbook called "UW" or "Valuation" (depending on which row it's on).
Incidentally, I'm not in Scotland - I'm in England.

let me check

Hi Rory

It runs perfectly. I was able to make other changes as well. How do i keep the destination file name saved same as source file names?

Thanks

I get a run time error 70, (permission denied) when i try this. Code dies on this line If Dir(strNewPath) <> "" Then Kill strNewPath, on changing dest path as maFileName(lngIndex) thanks.

Do you have full rights to the location where you are trying to save the files?

Yes, because i am saving it on C:\

Here is the code.


Option Explicit
Const mc_strTEMPLATE_FILE_PATH As String = "C:\Template.xls"
Const mc_strSAVE_FILE_PATH As String = "C:\"
Dim mwbMacro As Workbook
Dim mwbInvoice As Workbook
Dim mwbAddressesReport As Workbook
Dim mwbStaticReport As Workbook
Dim mwbLoanActivityReport As Workbook
Dim mwbLoanActivityAdditionalDatesReport As Workbook
Dim maFileName As Variant
Dim mbErrorSwitch As Boolean
Dim miInvoiceCount As Integer
Dim miCounter As Integer
Dim mdStatementDateBegin As Date
Dim mdStatementDateEnd As Date
Dim lsTitle As String
Dim lsFileName As String
Dim lsSavePath As String
Dim lrGSNStartRange As Range
Dim lrAccountsProcessedRange As Range
Dim lrCopyStartRange As Range
Dim lrPasteRange As Range
Dim lrFormulaRange As Range
Dim lrTransactionDetailRange As Range
Dim liBeginningBalance As Double
Dim liEndingBalance As Double
Dim liTransactionCounter As Integer
Dim ldCopyEffectiveDate As Date
Dim ldPasteEffectiveDate As Date

Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description: Gets list from user of those files to be processed.
'Arguments:
'Author:
'Changes:
'************************************************************************** ***************
Dim lngIndex As Long, lngOffset As Long
Dim rngCopy As Range, rngSource As Range, rngDest As Range
Dim wksSource As Worksheet, wksDest As Worksheet
Dim rngCell As Range
Dim shpCopyPic As Shape
Dim strNewPath As String
With Sheet1
Set rngCopy = .Range("A13:A19")
End With
lngOffset = 4
'Display a common file open dialog to the user to allow
'User to select files to be processed.
maFileName = Application.GetOpenFilename(Title:="Select File(s) to be processed", MultiSelect:=True)
If TypeName(maFileName) = "Boolean" Then
mbErrorSwitch = True
MsgBox Title:="Error", prompt:="No files chosen. Processing will now terminate."
Exit Sub
End If
' Loop through selected files
For lngIndex = LBound(maFileName) To UBound(maFileName)
' Open invoice workbook
Set mwbInvoice = Workbooks.Open(maFileName(lngIndex))
' open new template
Set mwbStaticReport = Workbooks.Open(mc_strTEMPLATE_FILE_PATH)
' Get save path
strNewPath = maFileName(lngIndex)
' Kill any existing file with the new save name
If Dir(strNewPath) <> "" Then Kill strNewPath
mwbStaticReport.SaveAs Filename:=strNewPath
' Copy data across
For Each rngCell In rngCopy
Set wksSource = mwbInvoice.Worksheets(rngCell.Value)
Set wksDest = mwbStaticReport.Worksheets(rngCell.Offset(0, lngOffset).Value)
Set rngSource = wksSource.Range(rngCell.Offset(0, 2).Value)
Set rngDest = wksDest.Range(rngCell.Offset(0, 2 + lngOffset).Value)
If rngCell.Offset(0, 1).Value = "Cells" Then
rngSource.Copy Destination:=rngDest
ElseIf rngCell.Offset(0, 1).Value = "Picture" Then
For Each shpCopyPic In wksSource.Shapes
Debug.Print shpCopyPic.TopLeftCell.Address
If shpCopyPic.TopLeftCell.Address = rngSource.Address Then
shpCopyPic.Copy
wksDest.Paste Destination:=rngDest
Exit For
End If
Next shpCopyPic
Else
' some other kind of copy!
End If
Next rngCell
With mwbStaticReport
.Save
.Close False
End With
mwbInvoice.Close False
Set mwbInvoice = Nothing
Set mwbStaticReport = Nothing
Next lngIndex
MsgBox prompt:="Your files have been saved"

End Sub

You seem to have lost the bit that changes the name based on B3. As a result, you are trying to delete the file you just opened!

what do i then buddy? What code change should i do?

i was trying to save output files with the same name as source files.

You need something like:
[VBA] strNewPath = mc_strSAVE_FILE_PATH & mwbInvoice.Name[/VBA]


Regards,
Rory

Run Time Error 1004, i changed the above. But get this error now.



Option Explicit
Const mc_strTEMPLATE_FILE_PATH As String = "C:\Template.xls"
Const mc_strSAVE_FILE_PATH As String = "C:\"
Dim mwbMacro As Workbook
Dim mwbInvoice As Workbook
Dim mwbAddressesReport As Workbook
Dim mwbStaticReport As Workbook
Dim mwbLoanActivityReport As Workbook
Dim mwbLoanActivityAdditionalDatesReport As Workbook
Dim maFileName As Variant
Dim mbErrorSwitch As Boolean
Dim miInvoiceCount As Integer
Dim miCounter As Integer
Dim mdStatementDateBegin As Date
Dim mdStatementDateEnd As Date
Dim lsTitle As String
Dim lsFileName As String
Dim lsSavePath As String
Dim lrGSNStartRange As Range
Dim lrAccountsProcessedRange As Range
Dim lrCopyStartRange As Range
Dim lrPasteRange As Range
Dim lrFormulaRange As Range
Dim lrTransactionDetailRange As Range
Dim liBeginningBalance As Double
Dim liEndingBalance As Double
Dim liTransactionCounter As Integer
Dim ldCopyEffectiveDate As Date
Dim ldPasteEffectiveDate As Date

Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description: Gets list from user of those files to be processed.
'Arguments:
'Author:
'Changes:
'************************************************************************** ***************
Dim lngIndex As Long, lngOffset As Long
Dim rngCopy As Range, rngSource As Range, rngDest As Range
Dim wksSource As Worksheet, wksDest As Worksheet
Dim rngCell As Range
Dim shpCopyPic As Shape
Dim strNewPath As String
With Sheet1
Set rngCopy = .Range("A13:A19")
End With
lngOffset = 4
'Display a common file open dialog to the user to allow
'User to select files to be processed.
maFileName = Application.GetOpenFilename(Title:="Select File(s) to be processed", MultiSelect:=True)
If TypeName(maFileName) = "Boolean" Then
mbErrorSwitch = True
MsgBox Title:="Error", prompt:="No files chosen. Processing will now terminate."
Exit Sub
End If
' Loop through selected files
For lngIndex = LBound(maFileName) To UBound(maFileName)
' Open invoice workbook
Set mwbInvoice = Workbooks.Open(maFileName(lngIndex))
' open new template
Set mwbStaticReport = Workbooks.Open(mc_strTEMPLATE_FILE_PATH)
' Get save path
strNewPath = mc_strSAVE_FILE_PATH & mwbInvoice.Name
' Kill any existing file with the new save name
If Dir(strNewPath) <> "" Then Kill strNewPath
mwbStaticReport.SaveAs Filename:=strNewPath
' Copy data across
For Each rngCell In rngCopy
Set wksSource = mwbInvoice.Worksheets(rngCell.Value)
Set wksDest = mwbStaticReport.Worksheets(rngCell.Offset(0, lngOffset).Value)
Set rngSource = wksSource.Range(rngCell.Offset(0, 2).Value)
Set rngDest = wksDest.Range(rngCell.Offset(0, 2 + lngOffset).Value)
If rngCell.Offset(0, 1).Value = "Cells" Then
rngSource.Copy Destination:=rngDest
ElseIf rngCell.Offset(0, 1).Value = "Picture" Then
For Each shpCopyPic In wksSource.Shapes
Debug.Print shpCopyPic.TopLeftCell.Address
If shpCopyPic.TopLeftCell.Address = rngSource.Address Then
shpCopyPic.Copy
wksDest.Paste Destination:=rngDest
Exit For
End If
Next shpCopyPic
Else
' some other kind of copy!
End If
Next rngCell
With mwbStaticReport
.Save
.Close False
End With
mwbInvoice.Close False
Set mwbInvoice = Nothing
Set mwbStaticReport = Nothing
Next lngIndex
MsgBox prompt:="Your files have been saved"

End Sub

Sorry, I should have anticipated that - you are trying to save the template with the same name as an open workbook, and you can't have two workbooks open with the same name, so we need to change the timing of the save:
[VBA]Option Explicit
Const mc_strTEMPLATE_FILE_PATH As String = "C:\Template.xls"
Const mc_strSAVE_FILE_PATH As String = "C:\"
Dim mwbMacro As Workbook
Dim mwbInvoice As Workbook
Dim mwbAddressesReport As Workbook
Dim mwbStaticReport As Workbook
Dim mwbLoanActivityReport As Workbook
Dim mwbLoanActivityAdditionalDatesReport As Workbook
Dim maFileName As Variant
Dim mbErrorSwitch As Boolean
Dim miInvoiceCount As Integer
Dim miCounter As Integer
Dim mdStatementDateBegin As Date
Dim mdStatementDateEnd As Date
Dim lsTitle As String
Dim lsFileName As String
Dim lsSavePath As String
Dim lrGSNStartRange As Range
Dim lrAccountsProcessedRange As Range
Dim lrCopyStartRange As Range
Dim lrPasteRange As Range
Dim lrFormulaRange As Range
Dim lrTransactionDetailRange As Range
Dim liBeginningBalance As Double
Dim liEndingBalance As Double
Dim liTransactionCounter As Integer
Dim ldCopyEffectiveDate As Date
Dim ldPasteEffectiveDate As Date
Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description: Gets list from user of those files to be processed.
'Arguments:
'Author:
'Changes:
'************************************************************************** ***************
Dim lngIndex As Long, lngOffset As Long
Dim rngCopy As Range, rngSource As Range, rngDest As Range
Dim wksSource As Worksheet, wksDest As Worksheet
Dim rngCell As Range
Dim shpCopyPic As Shape
Dim strNewPath As String
With Sheet1
Set rngCopy = .Range("A13:A19")
End With
lngOffset = 4
'Display a common file open dialog to the user to allow
'User to select files to be processed.
maFileName = Application.GetOpenFilename(Title:="Select File(s) to be processed", MultiSelect:=True)
If TypeName(maFileName) = "Boolean" Then
mbErrorSwitch = True
MsgBox Title:="Error", prompt:="No files chosen. Processing will now terminate."
Exit Sub
End If
' Loop through selected files
For lngIndex = LBound(maFileName) To UBound(maFileName)
' Open invoice workbook
Set mwbInvoice = Workbooks.Open(maFileName(lngIndex))
' open new template
Set mwbStaticReport = Workbooks.Open(mc_strTEMPLATE_FILE_PATH)
' Get save path
strNewPath = mc_strSAVE_FILE_PATH & mwbInvoice.Name
' Kill any existing file with the new save name
If Dir(strNewPath) <> "" Then Kill strNewPath
' Copy data across
For Each rngCell In rngCopy
Set wksSource = mwbInvoice.Worksheets(rngCell.Value)
Set wksDest = mwbStaticReport.Worksheets(rngCell.Offset(0, lngOffset).Value)
Set rngSource = wksSource.Range(rngCell.Offset(0, 2).Value)
Set rngDest = wksDest.Range(rngCell.Offset(0, 2 + lngOffset).Value)
If rngCell.Offset(0, 1).Value = "Cells" Then
rngSource.Copy Destination:=rngDest
ElseIf rngCell.Offset(0, 1).Value = "Picture" Then
For Each shpCopyPic In wksSource.Shapes
If shpCopyPic.TopLeftCell.Address = rngSource.Address Then
shpCopyPic.Copy
wksDest.Paste Destination:=rngDest
Exit For
End If
Next shpCopyPic
Else
' some other kind of copy!
End If
Next rngCell
mwbInvoice.Close False
Set mwbInvoice = Nothing
With mwbStaticReport
.SaveAs Filename:=strNewPath
.Close False
End With
Set mwbStaticReport = Nothing
Next lngIndex
MsgBox prompt:="Your files have been saved"
End Sub
[/VBA]

Hi "Rory"

I am good thanks. It works.

I have to include a whole bunch of other cells that we need to copy and paste. I am working on it right now. I will let you once i am done, if i need anything else. Its a lot of effort to identify those cells and then include them in the code. I am just scared that once i include cells from the complete worksheet, it may not work.

Thanks for all your help. greatly appreciated.

Not sure why you put my name in quotation marks?
If you maintain the table structure I used (rather than your original layout) it would be easy enough to have the code just pick up any new rows.

ok thanks...i will do that. I might need your help on something else. I am trying to figure out myself first in this code. I will post something out soon, if i cannot figure out myself.

Quotation Marks--thought thats just your screen name and not your real name. You will address some one Hi X, where X is the real name. So put Q.marks there as i was not sure rory is your real name.

Ah, I see. It's both a screen name and real name for me!

Hi Rory

The template (Valuation Worksheet) has a p/w. When I select a bunch of files to process, it asks me to enter the p/w to the number of files selected to be processed. Is it possible to bypass the p/w. I mean the macro runs without asking for the p/w. Here is my latest code.

Thanks

If it's a password to open (I haven't got time to look just now) then you can supply that as an argument to the Workbooks.Open method. If it's a change password, you can unprotect the sheets in code.

the p/w is only on Valuation Worksheet of the workbook. This is part of the template.

i did ActiveSheet.Unprotect, but did not help.

You would need:
Worksheets("Valuation").Unprotect passwordhere
If that doesn't work, I'll take a look tomorrow if no-one else jumps in first.

ok that sounds good..and i willl try to figure out meanwhile.

You didn't include the template so I'm guessing you need:
[VBA]
mwbStaticReport.Worksheets("Valuation").Unprotect passwordhere
[/VBA]
after you open the template, then reprotect if required at the end before you save the template to its new location.

Hi Rory

Here are the files:
The attachment has:

Macro so far.
Template - to which the data is copied too.

The template (Valuation Worksheet) has a p/w. When I select a bunch of files to process, it asks me to enter the p/w to the number of files selected to be processed. Is it possible to bypass the p/w. I mean the macro runs without asking for the p/w. But, when the files are finally saved, it still has the password. It gives me an error message when i tried the command from last message.

Also, I have 453 rows of data to be copied over as you can see in the Macro. Hopefully, it works. I donot have to make any more changes in the code for this??

Thanks for your help.

Hi

Its not capturing some of the cells listed in Macro? Any reason..do I need to make more code changes??

If i post the source file, will it be helpful?? And i get an error cannot change part of merged cell?

Thanks