I _think_ that this does what you want. It finds that last cell in the even
numbered rows and plops it into the first open row (starting at the bottom) in
column B.

Option Explicit
Sub testme01()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("CI1").Column

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
'do nothing
Else
If IsEmpty(.Cells(iRow, LastCol)) = False Then
Set myCell = .Cells(iRow, LastCol)
Else
If IsEmpty(.Cells(iRow, LastCol - 1)) = False Then
Set myCell = .Cells(iRow, LastCol - 1)
Else
Set myCell = .Cells(iRow, LastCol).End(xlToLeft)
End If
End If

With tWks
Set DestCell _
= .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
End With
'move the stuff
DestCell.Value = .Cells(1, myCell.Column)
'move the date, too????
DestCell.Offset(0, -1).Value = myCell.Value
End If
Next iRow
End With

End Sub

But maybe this is closer. It takes the even numbered rows and puts them in the
same order
(row 2 to 36 goes to rows 1 to 18 on sheet2):

Option Explicit
Sub testme02()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range
Dim myValToMove As Variant

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
FirstRow = 2
LastRow = 36
FirstCol = .Range("G1").Column
LastCol = .Range("CI1").Column

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
Set myCell = Nothing
Else
If IsEmpty(.Cells(iRow, LastCol)) = False Then
Set myCell = .Cells(iRow, LastCol)
Else
If IsEmpty(.Cells(iRow, LastCol - 1)) = False Then
Set myCell = .Cells(iRow, LastCol - 1)
Else
Set myCell = .Cells(iRow, LastCol).End(xlToLeft)
End If
End If
End If

If myCell Is Nothing Then
myValToMove = ""
Else
myValToMove = .Cells(1, myCell.Column)
End If

With tWks
Set DestCell = .Cells(iRow / 2, "B")
End With

'move the stuff
DestCell.Value = myValToMove

Next iRow
End With

End Sub

I wasn't sure.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Erik wrote:

I have sheet1 with info in cells G2 to CI37. Row1 contains column headers for events to be completed. Even numbered rows from 2 to 36 will contain the date of completion for the event in that column. I need excel to find the last cell in each of the even numbered rows with a date entered and determine the event (row1,column-last date entered). Then, place the last event completed for each even numbered row in a column in sheet2. Ex: Row2 has dates in the cells in columns G thrugh M corresponding to events 1-7. Therefore place the label event7 in cell B1 of sheet2. Row4's last date is in column K so place label event5 in cell B2 of sheet2. Etc.
Also, if either all cell are empty or all cells filled with dates, make the corresponding cell in sheet2 empty.
As always, any help is greatly appreciated.
Erik

--

Dave Peterson