另存为宏抛出运行时错误'1004'尽管在不同的工作簿中运行良好



感谢您在这里提供的所有帮助。

我决不是一个程序员,我会花几个小时搜索论坛,并分析一些代码来创建我需要的东西。我构建了以下代码,根据过滤器从一个工作簿中提取数据,然后另存为单个工作簿中的数据。这段代码在一个工作簿中运行得很好,但现在我已经尝试重用它了,它在尝试另存为时抛出了1004运行时错误。你知道哪里出了问题吗?

非常感谢,

Stephen

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

您需要找出这个常见错误代码-1004的实际原因。编辑你的函数/VBA代码,并在调试模式下运行你的程序,以识别导致它的行。然后,添加以下代码以查看错误,

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

我建议使用键盘上的调试快捷键-Step Into(F8(、Step Over

最新更新