Staci,


The following will work correctly as long as the three additional columns Quantity, Hours, and Avg. are in each Tracker??? worksheet.



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.





Option Explicit
Sub ReorgDataV3()
' stanleydgromjr, 03/16/2011
' http://www.excelforum.com/excel-general/768143-index-match-to-reformat-data.html
Dim ws As Worksheet, wF As Worksheet
Dim LR As Long, LC As Long, NR As Long, a As Long, aa As Long
Application.ScreenUpdating = False
If Not Evaluate("ISREF('Final Format'!A1)") Then Worksheets.Add(Before:=Worksheets(1)).Name = "Final Format"
Set wF = Worksheets("Final Format")
wF.UsedRange.Clear
wF.Range("A1:F1") = [{"Date","Last Name","First Name","Quantity","Hours","AVG."}]
For Each ws In ThisWorkbook.Worksheets
  If Left(ws.Name, 7) = "Tracker" Then
    With ws
      LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
      LC = ws.Cells(3, Columns.Count).End(xlToLeft).Column - 3
      For a = 4 To LC Step 3
        For aa = 4 To LR Step 1
          If Application.Count(ws.Range(ws.Cells(aa, a), ws.Cells(aa, a + 2))) > 0 Then
            NR = wF.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            wF.Cells(NR, 1).Value = ws.Cells(2, a).Value
            wF.Range("B" & NR).Resize(, 2).Value = ws.Range("A" & aa & ":B" & aa).Value
            wF.Range("D" & NR & ":F" & NR).Value = ws.Range(ws.Cells(aa, a), ws.Cells(aa, a + 2)).Value
          End If
        Next aa
      Next a
    End With
  End If
Next ws
LR = wF.Cells(Rows.Count, 1).End(xlUp).Row
wF.Range("A2:A" & LR).NumberFormat = "m/d/yyyy"
wF.Range("E2:F" & LR).NumberFormat = "0.00"
wF.Range("D2:F" & LR).HorizontalAlignment = xlCenter
wF.UsedRange.Columns.AutoFit
wF.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgDataV3 macro.