PDA

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



acsishere
07-18-2008, 10:04 AM
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.




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.

acsishere
07-19-2008, 04:56 AM
Dear Friends,

Any help? Please....

Thanks in advance.

acsishere.

acsishere
07-19-2008, 11:37 AM
Any help?

Please help me to find the solution.

Thanks in advance.

acsishere.

mdmackillop
07-19-2008, 01:52 PM
It is not clear what ranges/sheets are in which book. Qualify all such and avoid Selection, which should not be required.

Simon Lloyd
07-19-2008, 05:20 PM
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?

acsishere
07-20-2008, 12:52 AM
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.

mdmackillop
07-20-2008, 02:51 AM
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
TargetWorkBook.Sheets(1).Range("A1").CurrentRegion.ClearContents
SourceWorkBook.Sheets(1).Range("A1").CurrentRegion.Copy
TargetWorkBook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues



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

acsishere
07-20-2008, 03:44 AM
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: