ExcelBanter - Rearranging Data

Here's some code

Sub test()
Dim iLastRow As Long
Dim i As Long, j As Long, k As Long
Dim iRow As Long
Dim sh As Worksheet

Worksheets.Add(after:=Worksheets(Worksheets.Count) ).Name = "Summary"
With ActiveSheet
.Range("A1").Value = "Location"
.Range("B1").Value = "Day"
.Range("C1").Value = "Month"
.Range("D1").Value = "Amt1"
.Range("E1").Value = "Amt2"
iRow = 2
For i = 1 To Worksheets.Count - 1
Set sh = Worksheets(i)
iLastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For j = 2 To iLastRow
For k = 2 To 65 Step 2
If Not IsEmpty(sh.Cells(j, k).Value) Or _
Not IsEmpty(sh.Cells(j, k + 1).Value) Then
Cells(iRow, "A").Value = sh.Cells(j, "A").Value
Cells(iRow, "B").Value = k \ 2
Cells(iRow, "C").Value = sh.Index
Cells(iRow, "D").Value = sh.Cells(j, k).Value
Cells(iRow, "E").Value = sh.Cells(j, k + 1).Value
iRow = iRow + 1
End If
Next k
Next j
Next i
End With
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

"HIT Engineering" wrote in
message ...
I have data stored in an excel sheet in the following format. Column 1
contains a location. Columns 2-3 have values for day 1, Columns 4-5 have
values for day 2, etc... One set for each day of the month. There is a
seperate worksheet for each month. I would like to automate something to
put
all of the data on one sheet in only 5 columns. Column 1 Location, Column
2
Day, Column 3 Month, Column 4-5 the values. I have built this to
transport
into access but it takes way to long. Any help in the most efficient way
to
do this in excel?