need to copy data from one workbook to another on selected cells 2

[sanyup2000]

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.

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

i pasted at

http://www.vbaexpress.com/forum/showthread.php?t=15956

, but no response. The test file is located at this link.

 

[sanyup2000]

How do i keep the destination file name saved same as source file names?

 

[PHV]

maFileName(lngIndex)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[sanyup2000]

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

Thanks'

 

[sanyup2000]

Disregard..i am good and the code is working now, i think.

 

[sanyup2000]

I get a run time error 1004 (cannot change part of merged cells). I have posted the template, macro and source file. Save template on c:\template.xls. Click Run, select source file. Can anyone please help???

 

[sanyup2000]

Here is my code. The code breaks at:

rngSource.Copy Destination:=rngDest

It generates a run time error. Can anyone help.

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
Dim iCounter As Integer




Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description:
'Arguments:
'Author: Sandeep Upendra 12 Nov, 2007
'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:A410")
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)
ActiveSheet.Unprotect
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

 

[SkipVought]

You are unprotecting the active sheet whatever that is.

I prefer to reference a specific sheet.

Is the ActiveSheet, that is being unprotected, the DESTINATION sheet that the PASTE will occur on?

[b]
            ActiveSheet[/b].Unprotect
            If rngCell.Offset(0, 1).Value = "Cells" Then
                rngSource.Copy Destination:=[b]rngDest[/b]

Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}

 

[sanyup2000]

ActiveSheet.Unprotect i got rid of it. I still get the same error.

 

[SkipVought]

The point was, if rngDest.Parent (that sheet) is PROTECTED, you will get an error.

Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}

 

[sanyup2000]

It protected, but systems prompts to enter a p/w which i did? Even then i get an error. What can i do ?

 

[SkipVought]

"It protected, but systems prompts to enter a p/w which i did"

That is the sheet that you must unprotect, by supplying the proper password.

What is the Parent and Address properties of rngDest?


Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}

 

[sanyup2000]

What is the Parent and Address properties of rngDest?

it is the Valuation worksheet. Not sure, if i answered your question?

 

[SkipVought]

"What is the Parent and Address properties of rngDest?"

faq707-4594. You tell me.


Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}

 

[sanyup2000]

Here is the code. Will this help??



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:
'Arguments:
'Author: 12 Nov, 2007
'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:A453")
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)
ActiveSheet.Unprotect
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

 

[SkipVought]

No. It helps not a bit.

YOU, YOU, YOU...

must use the Watch Window to determine the answer as the code executes, in a BREAK.

Read the FAQ, and do some heavy lifting.

Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}

 

[sanyup2000]

In the above code, it breaks at:

rngSource.Copy Destination:=rngDest


Can you help ????

 

[SkipVought]

"BREAK" refers to a break that YOU put in your code so it STOPS, in order that YOU can observe values and object properties.

What are the PROPERTIES in rngSource & rngDest.

Is it what you expect?

Skip,

_{When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large}