Many WorkBooks to Summary WB

vinayguj

New Member
Joined
Jul 8, 2012
Messages
11
Hello to one in this wonderful forum!

I need some help on a Macro.

I have a folder with many Excel WorkBooks in it. All the WBs are encrypted by the same password.

The data in these WBs are in Sheet1, in the Column C5:C10.

The Macro should open each WB in the Folder and copy the data from C5:C10 and paste it in a Summary File in a Transpose manner, starting from Row 2. The data from each and every WB should be below each other, I mean; Row 3, Row 4......

As the Password for opening all the WBs are same, the Macro should open the WBs with the same password and it should not promt for password everytime it opens a file.

Any help would be appreciated.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

b.downey

Active Member
Joined
Oct 16, 2011
Messages
484
You will need to supply the Passwod and Path in the Two constants at the start of the SUB. Otherwise, this code should work per you requirements

Code:
Function Process()
    Const pswd As String = "DDD"
    Const InitPath As String = "C:\Documents and Settings\cpelab\My Documents"
    Dim FilePath As String
    Dim WbSrc As Workbook
    Dim RngSrc As Range
    Dim I As Integer
    
    Dim WsDst As Worksheet
    Dim DstRowNo As Long
    
    Set WsDst = ThisWorkbook.Worksheets(1)
    DstRowNo = 2
    ChDir InitPath
    FilePath = Dir("*.xls")
    
    Do While FilePath <> ""
        Debug.Print FilePath
        Set WbSrc = Workbooks.Open(Filename:=FilePath, ReadOnly:=True, Password:=pswd)
        
        Set RngSrc = WbSrc.Worksheets(1).Range("C5:C10")
        
        For I = 1 To RngSrc.Rows.Count
            WsDst.Cells(DstRowNo, I) = RngSrc.Cells(I, 1)
        Next I
        
        Call WbSrc.Close(SaveChangeS:=False)
        DstRowNo = DstRowNo + 1
        FilePath = Dir
    Loop
End Function
 

vinayguj

New Member
Joined
Jul 8, 2012
Messages
11
Hello Downey. Your codes work perfectly as desired. Thank you very much for your time and help. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,133,148
Messages
5,657,108
Members
418,355
Latest member
michaelirl

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top