Pivot Table Data Transfer

[moda7884]

Please help me? Thank you for reading.

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?

Here is the code below:

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)"