将 xlsx 文件保存在特定文件夹中答案

【问题标题】：Saving a xlsx file in a particular folder将 xlsx 文件保存在特定文件夹中
【发布时间】：2018-01-25 23:16:16
【问题描述】：

我正在尝试将源工作簿中的内容复制到新工作簿并以 xlsx 格式保存在指定文件夹中。

我正在尝试以下代码，但在代码的最后一行出现应用程序定义错误，我试图将我的新工作簿另存为 .xlsx

另外，大约需要很长时间。这段代码需要 5 分钟。

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

【问题讨论】：

filename 解析为什么？浏览您的代码，您似乎没有包含文件名称，因此您将尝试保存到无效的 ThisWorkbook.Path\Tru\Sq\.xlsx 之类的名称。
Filename 解析到什么？您所做的更改是有效的名称吗？
请注意：Dim i As Integer, j As Integer 使用 Long 而不是 Integer。 Excel 的行数超过了 Integer 可以处理的数量。而且您可能在Cells(i, 8).EntireRow.Delete 之前缺少.，它应该是.Cells(i, 8).EntireRow.Delete
至于速度问题，您需要弄清楚程序的哪一部分运行缓慢。保存文件不需要六分钟。如果没有重现问题的方法，就很难知道它是什么。
@Mikz 在你的循环中ThisWorkbook.Sheets("Pivottabelle").Range("A1:Y400").Copy 你将相同的范围一遍又一遍地复制到同一张纸上，然后你就这样做了LastRow-times。这没有多大意义，当然需要很多时间。我很确定复制一次就足够了？我的意思是如果范围没有改变为什么要循环？

标签： vba excel

【解决方案1】：

这应该显示了 cmets 的所有改进（以及更多）……

保存时可能会遇到问题，因为

DestinationPath = ThisWorkbook.Path & "\Tru\Sq\"

仅当包含工作簿的宏已保存时才有效。否则ThisWorkbook.Path 为空。您可能需要确保这些子文件夹已经存在。

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

【讨论】：

刚刚看到过程名newWB和变量同名，也应该避免。