0

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
Mikz
  • 571
  • 2
  • 11
  • 29
  • 1
    What does `filename` resolve to? Skimming over your code, it seems you don't include a name for your file so you would be trying to save to something like `ThisWorkbook.Path\Tru\Sq\.xlsx` which is not valid. – Ron Rosenfeld Jan 25 '18 at 13:22
  • @RonRosenfeld I have named it as newWB.saveas Filename:= path2 & "Project" &".xlsx" ; Still it gives the same error. And I don't understand , why it takes so long time to execute. It takes more than 6min – Mikz Jan 25 '18 at 13:26
  • 1
    And what does `Filename` resolve to? Is it a valid name with your changes? – Ron Rosenfeld Jan 25 '18 at 13:29
  • 1
    Just a note: Use `Long` instead of `Integer` for `Dim i As Integer, j As Integer`. Excel has more rows than Integer can handle. And you are probably missing a `.` before `Cells(i, 8).EntireRow.Delete` it should be `.Cells(i, 8).EntireRow.Delete` – Pᴇʜ Jan 25 '18 at 13:29
  • 2
    So far as the speed issue, you will need to figure out which part of your procedure is running slowly. It does not take six minutes to save a file. And without a method of reproducing your problem, it is hard to know what it is. – Ron Rosenfeld Jan 25 '18 at 13:29
  • @RonRosenfeld the copying portion takes a long time actually. – Mikz Jan 25 '18 at 13:32
  • 1
    Another note: If you `Dim path1, path2 As String` only `path2` is of type String and `path1` is Variant. You need to specify a type for **every** variable: `Dim path1 As String, path2 As String` – Pᴇʜ Jan 25 '18 at 13:34
  • @Peh thank you peh, – Mikz Jan 25 '18 at 13:34
  • 3
    @Mikz in your loop `ThisWorkbook.Sheets("Pivottabelle").Range("A1:Y400").Copy` you copy the same range over and over to the same sheet and you do it `LastRow`-times. That doesn't make much sense and takes a lot of time of course. I'm pretty sure it is enough to copy that once? I mean why the loop if the range doesn't change? – Pᴇʜ Jan 25 '18 at 13:38
  • @Peh thank you for the hint , Earlier I had a different idea and included that for loop. – Mikz Jan 25 '18 at 13:42

1 Answers1

2

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
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Just saw that the procedure name `newWB` was the same name as a variable, which should be avoided too. – Pᴇʜ Jan 25 '18 at 15:17