acsishere
07-25-2008, 11:16 AM
Best Wishes! Dear Friends,
This is with ref. to my own (solved) thread http://www.vbaexpress.com/forum/showthread.php?t=20967 in which the following code is written by Mr. Mdmackillop:
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
Actually the above code copies data from one workbook to another workbook.
I need a slight modification in this that the target workbook is only one Masterworkbook (from which I run the macro) in which all data from sourceworkbooks should be pasted.
Any help is highly appreciated.
Thanks in advance. acsishere.
This is with ref. to my own (solved) thread http://www.vbaexpress.com/forum/showthread.php?t=20967 in which the following code is written by Mr. Mdmackillop:
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
Actually the above code copies data from one workbook to another workbook.
I need a slight modification in this that the target workbook is only one Masterworkbook (from which I run the macro) in which all data from sourceworkbooks should be pasted.
Any help is highly appreciated.
Thanks in advance. acsishere.