谢谢大家的帮助。
我绝不是一个编码者,我花了好几个小时在论坛上搜索,并且可以用代码来创建我需要的东西。我建立了下面的代码来从一个工作簿中提取数据,基于过滤器,然后保存在一个单独的工作簿中。这段代码在一个工作簿中工作得非常好,但现在我试图重新使用它,当我试图保存为时,它抛出一个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
你需要找出这个常见错误代码的实际原因--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)