Copy Worksheets into a new workbook using VBA Macro

[VBAstudent1986]

I would like to copy and paste a worksheet that has pivot tables into a new workbook and save them using a specific name using a logic.

For example, in the sheet that has the pivots, I have a filter that has 250 Dealer Codes. I would like to export (Copy) the sheet after applying the filter and move to the next.

i.e. 1. Apply filter 2. Copy into new sheet 3. Save the file as a new workbook 4. File name should be from a list of dealer codes (List could be from a sheet within the original workbook)

Currently I am using the following code. If someone could help me that would be great. Currently I am getting error in the "SaveAs" line of the code - where I am getting the error.

Sub SplitWorkbook_Venkat()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd")
FolderName = xWb.Path & "\" & "Venkat"
'MkDir FolderName

Dim i As Long

i = 2

Do While i <= 280


ActiveSheet.PivotTables("PivotTable3").PivotFields("Dlr Num").ClearAllFilters
ActiveSheet.PivotTables("PivotTable3").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("PivotTable4").PivotFields("Dlr Num").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value

FPath = "D:\Jan 2020\Lease Loan Report New\Venkat\"
FName = "New_Report" & Sheets("DLRNUM").Cells(i, "A").Value & ".xls"


ThisWorkbook.Sheets("Pivot").SaveAs Filename:=FPath & "\" & FName
Application.ActiveWorkbook.Close False


i = i + 1

Loop

'MsgBox "You can find the files in " & FolderName

Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

Hi and welcome to the forum!

Consider the following macro:

Sub SplitWorkbook_Venkat()
  'Updateby20140612
  Dim FPath As String, FName As String, i As Long

  Application.ScreenUpdating = False
  FPath = "D:\Jan 2020\Lease Loan Report New\Venkat\"

  For i = 2 To 280
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Dlr Num").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Dlr Num").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
    FName = "New_Report " & Sheets("DLRNUM").Cells(i, "A").Value & ".xls"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=FPath & FName
    ActiveWorkbook.Close False
  Next
  Application.ScreenUpdating = True
End Sub

 

[VBAstudent1986]

Thanks a lot.. I i will try and let you know...

 

[VBAstudent1986]

It worked...!!!!!!! Thanks a ton!!!!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[VBAstudent1986]

Hello Dante Amor

Need help!!!!

In the above Macro, I would like the individual sheets to be saved as a protected sheet. is it possible???

 

[VBAstudent1986]

I mean, when it gets saved, the individual sheets needs to be protected with a password. Pleeeease let me know if this is possible..

 

[VBAstudent1986]

I added the following for protecting the sheet, but getting a pop up for whoch i have to say "ok" every single time...

Worksheets("Pivot").Protect Password:="showme"

Sub SplitWorkbook_Venkat_New_Retention()
'Updateby20140612
Dim FPath As String, FName As String, i As Long

Application.ScreenUpdating = False
FPath = "D:\Jan 2020\Lease Loan Report New\Venkat\"



For i = 2 To 10

' On Error Resume Next

Worksheets("Pivot").Unprotect Password:="showme"
ActiveSheet.PivotTables("Lease Terminations").PivotFields("ORIG_DEALER_CODE").ClearAllFilters
ActiveSheet.PivotTables("Lease Terminations").PivotFields("ORIG_DEALER_CODE").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("Repurchased Units").PivotFields("ORIG_DEALER_CODE").ClearAllFilters
ActiveSheet.PivotTables("Repurchased Units").PivotFields("ORIG_DEALER_CODE").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("Recent Terminations").PivotFields("ORIG_DEALER_CODE").ClearAllFilters
ActiveSheet.PivotTables("Recent Terminations").PivotFields("ORIG_DEALER_CODE").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("Defected Units").PivotFields("ORIG_DEALER_CODE").ClearAllFilters
ActiveSheet.PivotTables("Defected Units").PivotFields("ORIG_DEALER_CODE").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("Future Active Maturities").PivotFields("Dlr Num").ClearAllFilters
ActiveSheet.PivotTables("Future Active Maturities").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
ActiveSheet.PivotTables("Active vs Closed").PivotFields("Dlr Num").ClearAllFilters
ActiveSheet.PivotTables("Active vs Closed").PivotFields("Dlr Num").CurrentPage = Sheets("DLRNUM").Cells(i, "A").Value
FName = Sheets("DLRNUM").Cells(i, "C").Value & " " & Sheets("DLRNUM").Cells(i, "B").Value & " " & "Retention Rate Report" & ".xlsx"
'FName = Sheets("DLRNUM").Cells(i, "A").Value & " " & "New_Report" & " " & Sheets("DLRNUM").Cells(i, "B").Value .xls
Worksheets("Pivot").Protect Password:="showme"
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=FPath & FName
ActiveWorkbook.Close False
Next
Application.ScreenUpdating = True

MsgBox "Macro Complete"

End Sub

 

[DanteAmor]

I mean, when it gets saved, the individual sheets needs to be protected with a password. Pleeeease let me know if this is possible..

What do you want to protect, the active sheet or the new sheet of the new book?

 

[VBAstudent1986]

I would like to protect the new sheet of the new book...