This code WON'T do everything that you want, but should get you started in
the right direction:

Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range

Set rDest = ActiveWorkbook.Worksheets("Summary").Range("B3")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < "Summary" Then
rDest.Offset(0, -1).Value = ws.Name
With ws.Range("B39:T39") '< -- change range...
rDest.Resize(1, .Columns.Count).Value = .Value
End With
Set rDest = rDest.Offset(1, 0)
End If
Next ws

Change the ranges to suit your needs.

Regards,
Ryan---


--
RyGuy


"Dan" wrote:

Hi,
I have been searching a lot for what I want to do and so far can do some of
the individual components, but am not sure how to put it all together. I will
try to explain what I am trying to do as best as I can. Please let me know if
it is confusing.

-Workbook has 7 sheets (6 individual and 1 summary sheet)

I am trying to write a macro which will:
-Loop through all individual sheets, copying cell values to the Totals sheet
-Perform these actions on each individual sheet:
--Locate every row where Column I contains a number 0
--Copy values from that row in Columns A, B, I
--Go to first blank row in Totals sheet (there should be no gaps if using
Column B to look for values)
--Paste values using the following mapping: Individual!B1 should always be
Totals column A, Individual!B2 should always be Totals column B, Individual A
- Totals C, Individual B - Totals D, Individual I - Totals E
--Repeat for every row in Individual that has data in Column A between rows
6 and the first gap

-Loop through all six individual sheets (named Toby, Kristine, Carl, Amy,
Dan, Tamara), performing the actions above and always copy the cell values to
the first blank row in Totals, starting at Row 5.

I know this is a huge project and I have probably not explained it very well
but I would really appreciate any help anyone could offer me. I can provide
screen shots, or the file if that would help anyone.

Thank you!
-Dan