Tony, here's one solution assuming that the hr database is sorted by dept.
number:
Sub HRtoPhone()
Dim wsHR As Worksheet
Dim wsPh As Worksheet
Dim lRow As Long 'Last Row
Dim cnt As Long
Dim pDept 'Previous department
Dim iRow As Long 'Insert Row for Phone List sheet
'Change the following 2 lines to reflect the worksheets where the data is
Set wsHR = Workbooks("HR Data.xls").Worksheets("Data")
Set wsPh = Workbooks("PhoneList.xls").Worksheets("List")
With wsHR
lRow = .Range("A2").End(xlDown).Row
iRow = 1
For cnt = 2 to lRow
If .Range("A" & cnt) < pDept Then
wsPh.Range("A" & iRow + 1) = .Range("A" & cnt)
wsPh.Range("A" & iRow + 2) = .Range("B" & cnt) & _
" " & .Range("C" & cnt)
wsPh.Range("B" & iRow + 2) = .Range("E" & cnt)
iRow = iRow + 3
pDept = .Range("A" & cnt)
Else
wsPh.Range("A" & iRow) = .Range("B" & cnt) & _
" " & .Range("C" & cnt)
wsPh.Range("B" & iRow) = .Range("E" & cnt)
iRow = iRow + 1
End If
Next
End With
End Sub

Note: Not tested, post back or email me @ if you have
problems.
--
Charles Chickering

"A good example is twice the value of good advice."


"TonyD" wrote:

I am trying to take data from an excel database (HR Database) and create a
phone list by department in an existing worksheet (By First Name). I have to
use the Dept name as the header for each section followed by each person's
name combined as First&Last in column A followed by their phone number in
column B. For each new person in the same dept I want to put in the next row
until a blank line is met wher I will have a blank row in the Phone List
followed by the next Dept name and then their associated staff and phone
numbers. Since I very new to VBA, I could use a little hrlp getting started.


HR Database (worksheet name)

"A" "B" "C" "D" "E"
Dept First Last Title
Phone
-------- ------ ---- -----
-------
Payroll Wendy Davies Admin Assistant 555-440-4100
Payroll Tony Davies Analyst 555-440-5200
Acctg Sean Davies Accountant 555-440-6300
---------------------------------------------------------------------------------
By First Name (worksheet name)
(Space)
Payroll (Cell a8)
Wendy Davies(Cell a9) 555-440-4100(Cell b9)
Tony Davies 555-440-5200
(space)
Acctg (Cell a?)
Sean Davies(Cell a?? 555-440-6200(Cell b?)