Probably something like this is what you want: (untested pseudo code)

Dim bk as Workbook, bk2 as Workbook
Dim sh as Worksheet
set bk2 = Workbooks("Test Template (Revised).xls")
Thisworkbook.Activate
set sh = Worksheets("Pivot")

For Each itm In _
sh.PivotTables("PivotTable3") _
.PivotFields("Lessee").PivotItems
s = Itm.Value
sh.PivotTables("PivotTable3").PageFields(1).Page = itm.Value
sh.Cells.Copy
Workbooks.Add
set bk = ActiveWorkbook

Activesheet.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Activesheet.Cells.PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Activesheet.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
bk2.Sheets("PD").cells.copy bk.Sheets("sheet2").Cells
bk.Sheets("Sheet1").Name = "Form1"
bk.Sheets("Sheet2").Name = "Form2"
Application.DisplayAlerts = False
bk.Sheets("Sheet3").Delete
Application.DisplayAlerts = True
bk.Sheets("Form1").Range("B1").Copy _
bk.Sheets("Form2").Range("F6:H6")
Application.CutCopyMode = False
bk.SaveAs Thisworkbook.Path & "\" & s & ".xls"
bk.close SaveChanges:=False
ThisWorkbook.Activate
Next

--
Regards,
Tom Ogilvy


" wrote:

Please help me?

I am working in excel 2003. I have a working pivot table with over 50
entries. I need this marco to run each entry in the pivot table to
produce the data and then copy and paste the 2 worksheets into a new
workbook for each entry in the pivot table.
I need to paste two worksheets into new workbooks so clients can not
make changes. So far I am able to create one workbook just like I want
but after that it stops. I know I am missing something (I am learning
vba by myself ) but I am not sure what. Can someone please help me?

Sheets("Pivot").Select
For Each itm In
ActiveSheet.PivotTables("PivotTable3").PivotFields ("Lessee").PivotItems

Next
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Test Template (Revised).xls").Activate
Sheets("PD").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Sheets("Sheet2").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Form1"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Form2"
Sheets("Sheet3").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Form1").Select
Range("B1").Select
Selection.Copy
Sheets("Form2").Select
Range("F6:H6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "(All)"