Looping Through Worksheets

[draycut]

Hi Everyone..

I have a workbook named "Klaus", with a number of worksheets.. The first sheet it named "Ark" further I have a number of other worksheets with the same structure as shown here: (The solumns are A to C..)

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Year[/TD]
[TD]Weight[/TD]
[/TR]
[TR]
[TD]134[/TD]
[TD]2004[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]2004[/TD]
[TD]17[/TD]
[/TR]
[TR]
[TD]543[/TD]
[TD]2004[/TD]
[TD]13[/TD]
[/TR]
[TR]
[TD]247[/TD]
[TD]2004[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]364[/TD]
[TD]2004[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]357[/TD]
[TD]2004[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]853[/TD]
[TD]2004[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]245[/TD]
[TD]2004[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]864[/TD]
[TD]2004[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]2467[/TD]
[TD]2004[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]542[/TD]
[TD]2004[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2580[/TD]
[TD]2004[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]


What I want is a macro that loops through all the worksheets (Except the first one) and copies data from the other worksheets into "Ark". I want data from all three columns copied in BUT, I only want a certain number of rows.. The sum of the first 5 cells from the top of column C is 72.. So lets say that I have in some cell have the value 70, then I want the macro to copy the range Range("A2:C6") into "Ark", so the minimum range of cells across the three columns, where the sum from C2 and downwards is larger than 70 (in this example). Then I want the macro to go on to the next worksheet and do the same (with the same value (70)), but copy the cells in extension of the previously inserted cells in "Ark"..

Hope it makes sense and please dont hesitate the ask clarifying questions

So far I have this code..

Sub codesofar()    
    Application.ScreenUpdating = False
    
    Dim ark As Worksheet
    
    Set ark = Worksheets(1)
    
    For Each ws In Workbook
        If ws.Name <> "Ark" Then
            
            'HELP! ;)
            
            
        End If
    Next ws
    
End Sub

I am using Windows 7 and Excel 2013.

Any help is greatly appreciated!

 

[Mike LH]

Hi,

This uses Cell K1 on the Ark worksheet as the marker cell that contains the value 70 or whatever value you want to assign.

I have assumed that there will always be sufficient data in each sheet to add up to this marker value.

EDIT... I forgot to mention. see this line in the code. It sums the cells until the value is greater then the marker value.

If TempSum > dst.Range("K1") Then

You may want to use >= instead of >

Sub codesofar()
Dim ws As Worksheet, dst As Worksheet
Dim x As Long, LastRow As Long
Dim TempSum As Long
Set dst = Sheets("ark")
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> dst.Name Then
        LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
            For x = 2 To LastRow
                TempSum = TempSum + ws.Cells(x, "C")
                If TempSum > dst.Range("K1") Then
                    LastRow = dst.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    ws.Range("A2").Resize(x - 1, 3).Copy dst.Range("A" & LastRow)
                    TempSum = 0
                    LastRow = 0
                    GoTo getmeout
                End If
            Next
    End If
getmeout:
Next ws
    
End Sub

 

[draycut]

Hi Mike LH, first of all Thank yor very much, I see your idea!

Second.. Where do you put the line that you edited in?

 

[Mike LH]

Hi,

The way the code is written it will sum down column c until the sum of those cells is greater than the maker value when this line will evaluate as TRUE:-

If TempSum > dst.Range("K1") Then

It occurred to me after I'd written the code that you might want to terminate if the sum of column c was greater than or equal to the marker value. If that's what you want you replace the above line of code with this one.

If TempSum >= dst.Range("K1") Then

 

[draycut]

Hi Mike LH, first of all, thank you for taking the time, I see your idea!

But.. I dont get the "goto getmeout" line? This would immediately throw me on to the next sheet after the first iteration, regardless of whether
Tempsum > dst.Range("K1") rigtht? :/

Again,thank you!

 

[draycut]

Ah, cool, this works like a charm now, and I understand what's going on

Thank You so much for your help and explanation!

 

[Mike LH]

Hi Mike LH, first of all, thank you for taking the time, I see your idea!

But.. I dont get the "goto getmeout" line? This would immediately throw me on to the next sheet after the first iteration, regardless of whether
Tempsum > dst.Range("K1") rigtht? :/

Again,thank you!

No it won't do that. The code will iterate down column C adding up the values until TEMPSUM exceeds the value of the marker cell. Then and only then will the IF statement evaluate as TRUE and the statements inside the IF statement evaluate. Note that the Goto GetMeOut statement is inside the if --- End if statement. The purpose of that getmeout bit is so that the code stops adding more lines after the marker value has been reached.