Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste into new workbooks
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)" |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste into new workbooks
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)" |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste into new workbooks
Thank you for help. However, now I am recieving a problem and not sure
how to fix it. I get a Run Time Error 438 - Object doesn't support the property or method on line that reads: sh.PivotTables("PivotTable3").PageFields(1).Page = itm.Value Can someone please help me? Tom Ogilvy wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste into new workbooks
I am just guessing that your pagefield is the the pivotfield you are looping
through, so the code for that would be instead of: sh.PivotTables("PivotTable3").PageFields(1).Page = itm.Value probably should be: sh.PivotTables("PivotTable3").PivotFields("Lessee" ).CurrentPage = itm.Value When I say pseudo code, it means I just composed it in the email and didn't necessarily get all the object structures/syntax correct. But I would expect the above line to be correct if Lessee is the pagefield and you want to loop through all the pivotitem values in that field. -- Regards, Tom Ogilvy wrote in message ups.com... Thank you for help. However, now I am recieving a problem and not sure how to fix it. I get a Run Time Error 438 - Object doesn't support the property or method on line that reads: sh.PivotTables("PivotTable3").PageFields(1).Page = itm.Value Can someone please help me? Tom Ogilvy wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste into new workbooks
Thank you so much for your help so far. However, I have another
question. In my script I would like to save my workbooks to a mapped drive. I filled in the blanks for the save code and tried it out. It goes up to the third entry saves it and by the fourth I get a error message. Runtime error 1004 - MS Office Excel cannot access the file "\\blah\blah\blah" There are several possible reasons. It gives four options but the contiue button is grayed out. Can you help? Dawn Here is the sample code: bk.Sheets("PD").Range("F6:H6") Application.CutCopyMode = False bk.SaveAs Filename:="\\syslea222\busserve\Credit Logs\Archer Project\Master Customer List\" & Worksheets("PD").Range("F6").Value & ".xls" bk.Close SaveChanges:=False ThisWorkbook.Activate |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can't Copy and Paste or Paste Special between Excel Workbooks | Excel Discussion (Misc queries) | |||
Copy and paste between workbooks | Excel Discussion (Misc queries) | |||
Copy and paste between workbooks? | Excel Programming | |||
Copy and paste - two workbooks | Excel Programming | |||
Copy and Paste Between Workbooks | Excel Programming |