Summarize'd worksheet

[lill]

Hi

I am trying to get the "line" from many worksheets (when the have a value in one column) to a summarized worksheet:

Worksheet Cuterly
Artnr, Name, á-price, quantity, summarized price
1234 Knife 12 1 12
5678 Fork 15 2 30

Worksheet China
Artnr, Name, á-price, quantity, summarized price
2341 Dish 20 1 20
8567 Bowl 30 0

And I want all the lines (in the diffrent worksheets) with any value in the quantity column to show up in the summarized worksheet so I can summarize all the "wanted" information in one nic worksheet...
(like below)

Worksheet Summarized
Artnr, Name, á-price, quantity, summarized price
1234 Knife 12 1 12
5678 Fork 15 2 30
2341 Dish 20 1 20
=============== 4 === 62 ===

Hope someone can help me with this...

 

[jindon]

Hi
try

Sub test()
Dim ws As Worksheet, flg As Boolean, LastR As Range, wsSum As Worksheet
Set wsSum = Sheets("Summarized")
For Each ws In Worksheets
    If ws.Name <> wsSum.Name Then
        If flg Then
            Set LastR = wsSum.Range("a" & Rows.Count).End(xlUp).Offset(1)
            With ws.UsedRange
                With .Resize(.Rows.Count -1,.Columns.Count).Offset(1)
                    LastR.Resize(.Rows.Count,.Columns.Count).Value = .Value
                End With
            End With
         Else
            Set LastR = wsSum.Range("a1")
            With ws.UsedRange
                LastR.Resize(.Rows.Count,.Columns.Count).Value = .Value
            End With
            flg = True
        End If
    End If
Next
Set wsSum = Nothing
End Sub

 

[lill]

This only fetch data from one worksheet, and it will not update the information in the Sum... Worksheet.

And it fetch all the lines, even if they dont habe any qty. value...



I think their is a way to do this with "normal" forumels...''

Hope someone can get me going...

 

[jindon]

Paste the code onto Summarized sheet module

Private Sub Worksheet_Activate()
Dim ws As Worksheet, flg As Boolean, LastR As Range
For Each ws In Worksheets
    If ws.Name <> Me.Name Then
        If flg Then
            Set LastR = Me.Range("a" & Rows.Count).End(xlUp).Offset(1)
            With ws.UsedRange
                With .Resize(.Rows.Count -1,.Columns.Count).Offset(1)
                    LastR.Resize(.Rows.Count,.Columns.Count).Value = .Value
                End With
            End With
         Else
            Set LastR = Me.Range("a1")
            With ws.UsedRange
                LastR.Resize(.Rows.Count,.Columns.Count).Value = .Value
            End With
            flg = True
        End If
    End If
Next
End Sub

If you want formula solution, wait for the others.