Jim,
Thank you. I got an additional 1004 error when the code went to paste
the rng5 information into A6 of the ActiveSheet, so I moved the
rng5.copy line and everthing worked great.
Thank you for the lesson on the HLookup returning a value and not a
range. That made it click for me.

For the benefit of others the corrected Code:

Option Explicit

Sub CreateRoomSheets()

Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range, rngNR As Range, rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range, rng5 As Range, rCell As Range


Set WB = ThisWorkbook
Set SH = WB.Sheets("Room Blank")
Set rng = WB.Sheets("Room List").Range("RoomNo")
Set rngNR = WB.Sheets("RoomTypes").Range("ItemTable")
Set rng1 = WB.Sheets("Room List").Range("RoomName")
Set rng2 = WB.Sheets("Room List").Range("RoomTypeCol")
Set rng3 = WB.Sheets("Room List").Range("RoomRefCol")

On Error GoTo RET
Application.ScreenUpdating = False


For Each rCell In rng.Cells 'Excel.WorksheetFunction
Set rng4 = rngNR.Find(What:=rCell.Offset(0, 3).Value, _
LookAt:=xlWhole, LookIn:=xlFormulas,
MatchCase:=False)
If rng4 Is Nothing Then
MsgBox "Sorry, The item was not found"
End If
Set rng5 = Range(rng4.Offset(1, 0), rng4.Offset(51, 1))
rng5.Copy
With rCell
SH.Copy After:=WB.Sheets(WB.Sheets.Count)
With ActiveSheet
..Name = rCell.Value
..Range("B2") = rCell.Value
..Range("B3") = rCell.Offset(0, 1).Value
..Range("B4") = rCell.Offset(0, 2).Value
rng5.Copy
..Range("A6").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End With
Next rCell

RET:
Application.ScreenUpdating = True
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=532338