Sorry for the delay. Check this out:

Column A Column B
7 Bill Smith
3/15/2005
3/16/2005
3/30/2005
4/16/2005
Alex Baldwin
3/15/2005
3/16/2005
3/30/2005
4/16/2005
4/17/2005
4/19/2005
Kim Basinger
3/30/2005
4/16/2005
4/17/2005
4/19/2005

Enter this data into a spreadsheet starting at row A7

Here is the code that will (hopefully) do what your asking for:

There's a private sub routine and a function. Copy and paste the code into
the ThisWorkBook object. Hit F8 to cycle through the code line by line (I'm
sure you knew that though).

Option Explicit
Dim sUBound, sLBound As String 'Upper and Lower boundries
Dim sNextRange As String 'Holds the next range string
Dim sFirstRange As String 'Holds the first range string
Dim bolNextRange As Boolean 'Determins if next range has data

Private Sub CreateReport()
Dim strName As String
Dim intNameCount As Integer
Dim strFillRange As String

bolNextRange = True

'Cell A7 is the starting cell
sFirstRange = "A7"
Range(sFirstRange).Select

Do Until bolNextRange = False

Selection.Copy

GetDateRange

strFillRange = Replace(sUBound, "B", "A") & ":" & Replace(sLBound, "B",
"A")

Range(strFillRange).Select
ActiveSheet.Paste
Range(sFirstRange).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(sNextRange).Select
sFirstRange = sNextRange

Loop

End Sub

Function GetDateRange()

ActiveCell.Offset(RowOffset:=1, ColumnOffset:=1).Select

'Upper boundry
sUBound = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Do Until ActiveCell.Offset(RowOffset:=1).Value = ""
ActiveCell.Offset(RowOffset:=1).Select


Loop
sLBound = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
sNextRange = ActiveCell.Offset(RowOffset:=1,
ColumnOffset:=-1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
If ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-1).Value = "" Then
bolNextRange = False
Else
bolNextRange = True
End If


End Function

If you have any questions on the code, let me know ' )

HTH

Happy Coding


"tjtjjtjt" wrote in message
...
Here is what I have so far. It hangs after copying twice.

Sub TestCode()

For Each c In Range("A7:A200")
If c.Formula < "" Then
Do
c.Copy c.Offset(1, 0)
Loop While c.Offset(0, 1) < ""
Else
End If
Next c

End Sub

"tjtjjtjt" wrote:

I'm returning to Excel VBA after a brief introduction to it some months
ago.
Using Excel 2000.
I have a report that I import into Excel. I want to transform it into a
Excel List.
First I need to copy any value in Column A down while the cell in Column
B
for the same row contains data.
I then need to clear the cell that was orignally copied.
Last, I need to take the information in Column A and delete all rows in
the
UsedRange for which Column A is blank.

An example:
Cell A7 contains a name.
B8:B12 contain the dates the person will work.
I want the person's name to appear in A8:A12, and then clear cell A7.
Then, I would like Excel to find the next name and repeat the process.
The
first person will always be in A7, but names after that will be in
different
cells weekly.

I think I need some combination of offset, if and a do loop, but I've
been
unable to come up with anything that even gets close.

Any help would be greatly appreciated.
--
tj