Saving a xlsx file in a particular folder - vba

Question

I am trying to copy the content from source workbook to a new workbook and save it in xlsx format in a specified folder.
I am trying the below code and I get application defined error in the Last line of the code, where I am trying to save my new workbook as .xlsx
Also, It takes long time approx. 5min for this small piece of code.
Sub newWB()
Dim myWksht As String
Dim newWB As Workbook
Dim MyBook As Workbook
Dim i As Integer, j As Integer
Dim LastRow As Long, totalrows As Long
Dim path1, path2 As String
path1 = ThisWorkbook.Path
path2 = path1 & "\Tru\Sq\"
Set newWB = Workbooks.Add
With ThisWorkbook.Worksheets("Pivottabelle")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With newWB.Sheets("Sheet1")
.Name = "PivotTable"
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
With Worksheets("Pivottabelle")
For i = 1 To LastRow
ThisWorkbook.Sheets("Pivottabelle").Range("A1:Y400").Copy: newWB.Sheets("PivotTable").PasteSpecial
Next i
End With
With newWB.Worksheets("PivotTable")
totalrows = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = totalrows To 2 Step -1
If .Cells(i, 8).Value <> "TRU" Then
Cells(i, 8).EntireRow.Delete
End If
Next
newWB.SaveAs Filename:=path2 & ".xlsx"
End With
End Sub

Answer 1

This should show all the improvements from the comments (plus some more) …
It can be that you run into issues when saving because this
DestinationPath = ThisWorkbook.Path & "\Tru\Sq\"
only works if the macro containing workbook is already saved. Otherwise ThisWorkbook.Path is empty. And you probably need to be sure that these subfolders already exist.
Option Explicit 'force variable declare
Public Sub AddNewWorkbook() 'sub and newWB had the same name (no good practice)
'Dim myWksht As String 'not used therefore can be removed
Dim newWB As Workbook
'Dim MyBook As Workbook 'not used therefore can be removed
'Dim i As Integer, j As Integer
Dim i As Long, j As Long 'use long instead of integer whenever possible
'see https://stackoverflow.com/a/26409520/3219613
Dim LastRow As Long, totalrows As Long
'Dim path1, path2 As String 'always specify a type for every variable
Dim DestinationPath As String 'we only need one path
DestinationPath = ThisWorkbook.Path & "\Tru\Sq\"
'path2 = path1 & "\Tru\Sq\" ' can be reduced to one path
Set newWB = Workbooks.Add
With ThisWorkbook.Worksheets("Pivottabelle")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With newWB.Sheets("Sheet1")
.Name = "PivotTable"
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
'With Worksheets("Pivottabelle") 'unecessary with (not used at all)
'For i = 1 To LastRow 'unecessary loop
ThisWorkbook.Sheets("Pivottabelle").Range("A1:Y400").Copy
newWB.Sheets("PivotTable").PasteSpecial
'Next i
'End With
With newWB.Worksheets("PivotTable")
totalrows = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = totalrows To 2 Step -1
If .Cells(i, 8).Value <> "TRU" Then
.Cells(i, 8).EntireRow.Delete 'was missing a . before Cells(i, 8).EntireRow.Delete
End If
Next
newWB.SaveAs Filename:=DestinationPath & "FILENAME" & ".xlsx" 'was missing a filename
End With
End Sub