CODEWITHSUNDEEP
excelvba
CleanRider
CleanRider

Reputation: 149

Creating new worksheets based on pivot table values in the same workbook

I've tried running the following code to create new worksheets based on pivot table row lables....

 Sub test()
Dim lastrow As Long, x As Long, CurWs As Worksheet

lastrow = Sheets("Pivot Table").cells.Find("*", cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

With Sheets("Pivot Table")
For x = 6 To lastrow - 1
  Set CurWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
 CurWs.Name = ThisWorkbook.Sheets("PivotTable").cells(x, 1)
Next x
End With


End Sub

The line Set CurWs where I get the runtime error 429 "AciveX Compnonent Can create object" again on the same line

Upvotes: 1

Views: 56

Answers (2)

Julio Gadioli Soares
Julio Gadioli Soares

Reputation: 336

Here it is with space Sheets("Pivot Table") and here it is without ThisWorkbook.Sheets("PivotTable").Cells(x, 1)

It wouldn't be that?

Upvotes: 1

Pᴇʜ
Pᴇʜ

Reputation: 57683

  • Tidy up your code. Eg. only reference a worksheet by its name once. If you do that multiple times you easily run into typos. Furthermore if its name ever changes you will have to change it in every place. If you reference it to a variable then you only have to change it once.

  • Format it nicely to see your issues.

  • Don't mix Sheets and Worksheets they are not the same. Worksheets contains only worksheets but Sheets contains all kind of sheets like worksheets, chart sheets, etc. Especially when using counts of worksheets/sheets they might have a different .Count. So use the one you actually need and don't mix them.

  • Make sure every Range, Cells, Rows and Columns object has a worksheet referenced. Here Find("*", cells(1, 1) the Cells object has no worksheet reference and therefore Excel might fail guessing the right worksheet if you don't specify it explicitly.

Option Explicit 

Public Sub test()
    Dim PivotSheet As Worksheet
    Set PivotSheet = ThisWorkbook.Worksheets("Pivot Table")

    Dim LastRow As Long
    LastRow = PivotSheet.Cells.Find("*", PivotSheet.Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

    Dim x As Long
    For x = 6 To LastRow - 1
        Dim CurWs As Worksheet
        Set CurWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        CurWs.Name = PivotSheet.Cells(x, 1)
    Next x
End Sub

Upvotes: 2

Related Questions