Solved: Macro to create a Table using individual sheets totals as the input

[JimS]

I need to create a Table on a Totals Sheet that captures Row 1, 2 & 3 information for each column, from several Source Sheets in the same workbook.

Each Source Sheet could have several "sets" of data points that need to be copied in to the Table in a certain order.

Each Source Sheet’s name begins with the name "Sheet" (ie: Sheet1, Sheet1 (2), Sheet1 (3), etc). There could be anywhere from 1 to 32 Source Sheets containing data points that need to populate the Totals Table.

The data points do not get populated into the Table in the same order that they are laid out on the Source Sheet though. This might be the most difficult part.

I have included an example file that shows what I’m trying to accomplish.

Thanks for any and all help.

Jim

[Bob Phillips]

Crikey, that was a toughie

[vba]

Public Sub ProcessSheets()
Const BASE_FORMULA As String = _
"=MID(<cell>,FIND(""\"",<cell>)+2,FIND(""."",<cell>,2+FIND(""\"",<cell> ))-FIND(""\"",<cell>)-2)&"":""&" & _
"MID(<cell>,FIND(""("",<cell>)+1,FIND("")"",<cell>,1+FIND(""("",<cell>) )-FIND(""("",<cell>)-1)"
Dim sh As Worksheet
Dim target1 As Worksheet
Dim target2 As Worksheet
Dim LastCol As Long
Dim NextRow As Long
Dim i As Long, j As Long, k As Long

Application.ScreenUpdating = False

Set target1 = Worksheets("Totals1")
Set target2 = Worksheets("Totals2")
NextRow = 2
For Each sh In ActiveWorkbook.Worksheets

If Not sh Is target1 And Not sh Is target2 Then

LastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
For i = 2 To LastCol Step 6

target1.Cells(NextRow, "A").Formula = Replace(BASE_FORMULA, "<cell>", "'" & sh.Name & "'!" & sh.Cells(5, i).Address)
target2.Cells(NextRow, "A").Formula = Replace(BASE_FORMULA, "<cell>", "'" & sh.Name & "'!" & sh.Cells(5, i).Address)

For j = 1 To 3

For k = 1 To 3

With target1

.Cells(NextRow, (j * 3) - 2 + k).Formula = "='" & sh.Name & "'!" & sh.Cells(j, i + k - 1).Address(False, False)
sh.Cells(j, i + k - 1).Copy
.Cells(NextRow, (j * 3) - 2 + k).PasteSpecial Paste:=xlPasteFormats
End With

With target2

.Cells(NextRow, (j * 3) - 2 + k).Formula = "='" & sh.Name & "'!" & sh.Cells(j, i + k + 2).Address(False, False)
sh.Cells(j, i + k + 2).Copy
.Cells(NextRow, (j * 3) - 2 + k).PasteSpecial Paste:=xlPasteFormats
End With
Next k
Next j

NextRow = NextRow + 1
Next i
End If
Next sh

Application.ScreenUpdating = True
End Sub
[/vba]

[JimS]

xld,

Wow - this is very good, Thank you.

Only 1 issue that I see, it was using "every" sheet no matter what it's name was.

I need it to just use the sheets whose names begin with "Sheet" as the Source Sheets.

I added this:

If Left(sh.Name, 5) = "Sheet" Then

Thanks again, I had no idea how to start to write this code.


Jim