Solved: Copy and Paste - File to File (All files are Password Protected)

Dear Friends,

I have a code which does the following:

It runs from a separate file. It opens the Fname.XLS and see the file name & it's password, if right, then opens the source file (where the data is avaiable) to copy and then opens the Evaluation1 sheet in the same file to paste.

Code:

---

Sub COPYTOE1()
' THIS CODE COPIES DATA FROM MASTERSHEET TO EVALUATION1 SHEET

  Dim myFileNames As String
  Dim myPasswords As String
  Dim myRealWkbkName As String
  Dim LastRowA1 As Long
  Dim LastRowB1 As Long
  Dim PWWorkbook As Workbook
  Dim SourceWorkbook As Workbook
  Dim WorkbookPath As String
  Dim i As Integer
  Dim LastRow As Long
  Dim LastColumn As Long
  Dim rng As Range

  Application.ScreenUpdating = False

  myRealWkbkName = "C:\TEST\FNAME.xls"
  WorkbookPath = "C:\TEST\USER\"

  Workbooks.Open myRealWkbkName, UpdateLinks:=False
  Set PWWorkbook = ActiveWorkbook

  LastRowA1 = PWWorkbook.Sheets("Sheet1").[A1].End(xlDown).Row
  LastRowB1 = PWWorkbook.Sheets("Sheet1").[B1].End(xlDown).Row

  If LastRowA1 <> LastRowB1 Then
      MsgBox "check names & passwords--qty mismatch!"
      Exit Sub
  End If

  For i = 1 To LastRowA1

      myFileNames = PWWorkbook.Sheets(1).Cells(i, 1).Value
      myPasswords = PWWorkbook.Sheets(1).Cells(i, 2).Value

      Workbooks.Open WorkbookPath & myFileNames, UpdateLinks:=False, Password:=myPasswords
      Set SourceWorkbook = ActiveWorkbook

      Range("E1COPYAREA").ClearContents
      Set rng = Range("COPYTOE")

      rng.Copy
      Sheets("EVALUATION1").Select
      Range("A4").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Application.CutCopyMode = False
      Range("G4").Select
      SourceWorkbook.Close SaveChanges:=True

  Next i

  PWWorkbook.Close SaveChanges:=False

  Application.ScreenUpdating = True
  Range("A1").Select
  MsgBox "DATA FROM ALL FILES ARE COPIED IN RELATED FILES.  THANK YOU", vbOKOnly

End Sub

---

I need the modification in the above code to do the following:

In Fname.Xls, ColA data consist MASFILEs. ColB data consists Passwords. ColC consists REPFILEs (Masfile1 & Repfile1 are having similar password PASSWORD1 and Masfile2 & Repfile2 password is PASSWORD2 and so on...)

The above code copies & pastes the Range within the same workbook. I need to copy Range COPYTOE and then to paste in another workbook (the related REPFILE).

Any help highly appreciated. Please....help me to find the solution.

Thanks in advance.

acsishere.

Dear Friends,

Any help? Please....

Thanks in advance.

acsishere.

Any help?

Please help me to find the solution.

Thanks in advance.

acsishere.

It is not clear what ranges/sheets are in which book. Qualify all such and avoid Selection, which should not be required.

You use named ranges but don't specify which worksheet they belong to, as MD said VBA will assume you mean the activesheet. Perhaps a sample workbook will help?

Thanks for your considerations.

I am herewith attached a zip file in which I explained almost all required clarifications.

The macro should run from Runcode.xls.
The details are in ListFN.XLS.

I will be very much happy to furnish more details, if required.

Thanks for your support and seek in future also,

acsishere.

Personally, I would not use range names in this code unless the ranges are dynamic. In either case, it is only necessary to identify the top left cell of the paste area as the target. Also consider using CurrentRegion eg
[VBA]TargetWorkBook.Sheets(1).Range("A1").CurrentRegion.ClearContents
SourceWorkBook.Sheets(1).Range("A1").CurrentRegion.Copy
TargetWorkBook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues[/VBA]


[VBA]
Sub COPYTOE1()
' THIS CODE COPIES DATA FROM MASTERSHEET TO EVALUATION1 SHEET
Dim myPasswords As String
Dim myRealWkbkName As String
Dim LastRowA1 As Long
Dim LastRowB1 As Long
Dim PWWorkbook As Workbook
Dim SourceWorkBook As Workbook
Dim TargetWorkBook As Workbook
Dim WorkbookPath As String
Dim i As Integer
Dim LastRow As Long
Dim LastColumn As Long
Application.ScreenUpdating = False
myRealWkbkName = "C:\TEST\FNAME.xls"
WorkbookPath = "C:\TEST\USER\"
Workbooks.Open myRealWkbkName, UpdateLinks:=False
Set PWWorkbook = ActiveWorkbook
LastRowA1 = PWWorkbook.Sheets("Sheet1").[A1].End(xlDown).Row
LastRowB1 = PWWorkbook.Sheets("Sheet1").[B1].End(xlDown).Row
If LastRowA1 <> LastRowB1 Then
MsgBox "check names & passwords--qty mismatch!"
Exit Sub
End If
With PWWorkbook.Sheets(1)
For i = 1 To LastRowA1
myPasswords = .Cells(i, 2).Value
Set SourceWorkBook = Workbooks.Open(WorkbookPath & .Cells(i, 1), UpdateLinks:=False, Password:=myPasswords)
Set TargetWorkBook = Workbooks.Open(WorkbookPath & .Cells(i, 3), UpdateLinks:=False, Password:=myPasswords)
TargetWorkBook.Sheets(1).Range("E1COPYAREA").ClearContents
SourceWorkBook.Sheets(1).Range("COPYTOEVAL").Copy
TargetWorkBook.Sheets(1).Range("E1COPYAREA").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
TargetWorkBook.Close SaveChanges:=True
SourceWorkBook.Close SaveChanges:=False
Next i
End With

PWWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
Range("A1").Select
MsgBox "DATA FROM ALL FILES ARE COPIED IN RELATED FILES. THANK YOU", vbOKOnly
End Sub

[/VBA]

It's really unbelievable! In no time you solved it. That too in the first run. How confident you are! Genius! Not only for the code & but for understanding my problems also.

I tested the code with few sample files and it works excellently. You are great! Besides, the code seems to be very easy to modify. Excellent work Sir.

I will take your advice not to include the named range.

Thanks for spending your valuable time. Again & Again Thank you and it's you who saved me from lots of pressure.

Thanks. acsishere.:bow: