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

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