Data transfer from pivot table macro

[moda7884]

Please help me? Thank you for reading.

I am working in excel 2003. I have a working pivot table with over 50
entries. I need to take certain parts of the data to new worksheets so
clients can not make changes. I need this marco to run each entry in
the pivot table to produce the transfer data and then copy and paste
the information into a new workbook for each entry in the pivot table
with two forms(already created) with the data in it. 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)"