尽管在不同的工作簿中运行良好，但保存为巨集时仍出现运行时间错误'1004'。

Question

谢谢大家的帮助。

我绝不是一个编码者，我花了好几个小时在论坛上搜索，并且可以用代码来创建我需要的东西。我建立了下面的代码来从一个工作簿中提取数据，基于过滤器，然后保存在一个单独的工作簿中。这段代码在一个工作簿中工作得非常好，但现在我试图重新使用它，当我试图保存为时，它抛出一个1004运行时错误。请问是哪里出了问题？

非常感谢。

斯蒂芬

Sub Split()

Dim ws     As Worksheet
Dim wsNew  As Workbook
Dim rData  As Range
Dim rfl    As Range
Dim state  As String
Dim myValue As Variant
Dim sfilename As String
Dim FolderName As String
Dim strDir As String

myValue1 = InputBox("What date is this save for? (Format: DD Month)")

Range("B1").Select
Selection.AutoFilter
Set ws = ThisWorkbook.Sheets("Combined Data")

With ws
Set rData = .Range(.Cells(1, 2), .Cells(.Rows.Count, 13).End(xlUp))
.Columns(.Columns.Count).Clear
.Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

 MsgBox "Please select the folder to save files"
           FolderName = GetFolder()
        If FolderName = "" Then
        MsgBox "No folder was selected. Program will terminate."
        Exit Sub
    End If

For Each rfl In .Range(.Cells(2, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
state = rfl.Text

strDir = FolderName & "\" & state

If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
Else

End If

Set wsNew = Workbooks.Add
sfilename = "Monday" & " " & myValue1 & " - Engagement" & ".xlsx"

ActiveWorkbook.SaveAs strDir & "\" & sfilename

Answer 1

你需要找出这个常见错误代码的实际原因--1004。编辑您的functionVBA代码，并在调试模式下运行您的程序，以确定导致它的行。然后，添加以下代码来查看错误。

On Error Resume Next
// your code goes here which causes 1004 error
If Err.Number > 0 Then
  Debug.Print Err.Number & ":" & Err.Description
End If

我建议使用键盘上的调试快捷键--步入(F8)、跨过(换挡 + F8)、走出(Ctrl + 换挡 + F8)