This is the way I did it in the second version (did you notice that one?)

(This time with some comments intermingled.)

Option Explicit
Sub testme03()

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 myValToCopy As Variant

Set fWks = Worksheets("Tracker")

'I like a single spot to hold the worksheet name.
'if the name changes, I just fix it once.
'and by using a variable declared as a Worksheet, I get the VBA's
'intellisense to pop up when I hit that dot (like in twks. <--).
Set tWks = Worksheets("infotest")

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

For iRow = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRow, FirstCol), .Cells(iRow, LastCol))
'if they're all filled or all empty
'then make the cell to copy "Nothing"
'we'll check for that later.
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
Set myCell = Nothing '<--
Else
'but if they're not all empty, start looking for the last one
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
'notice that this "end if" got moved up and we'll always check
'to see what to move--either "" or the real value.

'now check to see what we found.
'if I'm not supposed to copy anything, mycell will be nothing
'else it'll be the value of what's in row 1 of that
mycell.column.
If myCell Is Nothing Then
myValToCopy = ""
Else
myValToCopy = .Cells(1, myCell.Column)
End If

'plop it in!
tWks.Cells((iRow / 2) + 3, 10) = myValToCopy

Next iRow
End With

End Sub

Now, one question. Why did you change the iRow variable to iRo? Just curious.


Erik wrote:

Dave,
I played around with the code you suggested and got it to do what I wanted with one exception. If all the cells in a row are empty or all are full, I want to make the corresponding cell in sheet2 empty as well. I got the all full part to work, but can't seem to figure out the all empty one. The following is what I have so far. Any suggestions would be greatly appreciated.
Erik

Dim fWks As Worksheet
Dim iRo 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

Set fWks = Worksheets("Tracker")

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

For iRo = FirstRow To LastRow Step 2
Set myRng = .Range(.Cells(iRo, FirstCol), .Cells(iRo, LastCol))
If myRng.Cells.Count = Application.Count(myRng) _
Or Application.Count(myRng) = 0 Then
'do nothing
Else
If IsEmpty(.Cells(iRo, LastCol)) = False Then
Sheets("infotest").Cells((iRo / 2) + 3, 10) = ""
Else
If IsEmpty(.Cells(iRo, LastCol - 1)) = False Then
Set myCell = .Cells(iRo, LastCol - 1)
Else
Set myCell = .Cells(iRo, LastCol).End(xlToLeft)
End If
End If

Sheets("infotest").Cells((iRo / 2) + 3, 10) = .Cells(1, myCell.Column)

End If
Next iRo
End With

--

Dave Peterson