multiple cell copy & total from multiple books to new single workbook with sheets

IanWells

Board Regular
Joined
Apr 2, 2003
Messages
86
Right guys need a way to do the following.....

I have several folders that contain workbooks with Jan to dec sheets.

i need to copy cells z5 to z10 (maybe individually) in each workbook in each worksheet and total the sum and paste it to a new workbook.

So, it needs to jump into a certain Location that contains workbooks, total z5 for january worksheet then sum it to c4 january worksheet in master workbook.

then reapeat for z6, z7, z8, z9, z10 to master c5, c6, c7, c8, c9

and then for Febuary, march etc to december.

If i get the code for january z5:10 then i'm sure i could amend for all the rest of the months, i guess this maybe simpler.

Hope its clear enough for you wizards.

Many thanks in help with this.

Ian Wells
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
You could use formulas to collect all data.
Assuming all files are opened in EXCEL.
In a REVIEW sheet you can enter:
A5 = Name of the file
B5 = Name of the sheet
C5 = cell address
D5 = ="[" & A5 &"]" &B5 & "!" & C5
E5 = =INDIRECT(D5)
E5 will collect the value of the cell mentioned in the right file and sheet
Then adapt to others cells
 
Upvote 0
Right i've done this but know its not ok but may be on right tracks if anyone can tweak or make right, please i am very new to this...

###################################
Sub test()
Dim myDir As String, fn As String
Dim wbk As Workbook, wks As Worksheet
Dim varData
Application.ScreenUpdating = False
myDir = "Z:\Timesheets\Timesheets\Employees\Accounts\"
fn = Dir(myDir & "*.xls")
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
Set wbk = Workbooks.Open(myDir & fn, UpdateLinks:=0)
Set wks = wbk.Sheets(1)

varData = wks.Range("z5").Value
ThisWorkbook.Sheets(1).Total("c4").End

Set wks = Nothing
wbk.Close False
Set wbk = Nothing
End If
fn = Dir
Loop
End Sub
################################
 
Upvote 0
Here some code which could help.
Assuming there is a cell named MyDIR where is informed the path for the working directory (Include last \)
In the macro inform month/sheet name.
Code:
Option Explicit
Option Base 1    ' Set default array subscripts to 1.
Sub test()
Dim myDIR As String, fn As String
Dim wbk As Workbook
Dim MyRANGE As Range
Dim MyRANGE_Total As Range
Dim VarData(6)
Dim Range_Size As Integer
Dim I As Integer, J As Integer
Dim MONTH()
    MONTH = Array("Jan", "Feb", "Mar", "April", "May", "Jun", "Juil", "Aug", "Sept", "Oct", "Nov", "Dec")
    Application.ScreenUpdating = False
    myDIR = Range("MyDIR")
    fn = Dir(myDIR & "*.xls")
    Do While fn <> ""
        If fn <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(myDIR & fn, UpdateLinks:=0)
            For J = 1 To UBound(MONTH)
                Set MyRANGE = wbk.Sheets(MONTH(J)).Range("Z5:Z10")
                Set MyRANGE_Total = ThisWorkbook.Sheets(MONTH(J)).Range("C4:C9")
                Range_Size = MyRANGE_Total.Rows.Count
                For I = 1 To Range_Size
                    MyRANGE_Total.Cells(I, 1) = MyRANGE_Total.Cells(I, 1) + MyRANGE.Cells(I, 1)
                Next I
            Next J
            wbk.Close False
        End If
        fn = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
PCL

What can I say, absolutely what I was looking for, i've just tweaked a little for PATH and month names where actually full ie January not jan but that was great...

Thanks you very much it IS very much appreciated

Ian (Leaner) Wells
 
Upvote 0
Hi

Can anyone or PCL just tweak a little more and clear or replace the destination cells before update, i notice it just adds to existing if ran more than once.

Cheers in anticipation

Regards

Ian
 
Upvote 0
Just add before treatment

Code:
'----   CLEAR  OLD  DATA  ----
            For J = 1 To UBound(MONTH)
                ThisWorkbook.Sheets(MONTH(J)).Range("C4:C9").ClearContents
            Next J
'----   TREATMENT  ----
    Do While fn <> ""
 
Upvote 0

Forum statistics

Threads
1,213,517
Messages
6,114,085
Members
448,548
Latest member
harryls

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
Back
Top