Excel 使用vba将每个文件保存到不同的位置

我需要以下方面的帮助： 我发现VBA代码可以根据数据从Excel工作表中复制数据，然后将这些数据放入新文件并保存

我需要一些东西，使在这个代码中的每个文件保存在不同的地方，这取决于过滤器的名称代码是用来分离数据从原始表

例如：如果过滤器名称在“书籍”中，我希望文件以“书籍”名称保存在文件夹中，如果过滤器名称为“故事”，我希望文件以“故事”名称保存在文件夹中。。。等等

我会附上我的密码

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim DT As String
Dim WBNAM As String
Dim FilePATH As String
Dim FILEEXT As String


vcol = 7
Set ws = Sheets("ER")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:G1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"

Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select


For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Workbooks.Add
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
Windows("Book1").Activate
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit

Sheets(myarr(i) & "").Range("A1:S1").Delete
Sheets(myarr(i) & "").Range("g:k").Delete
    Sheets("Sheet1").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

WBNAM = "_ER_"
DT = Format(CStr(Now), "DDMMYYYY")
FilePathe = "C:\Users\DODO\Desktop\New folder\"
FILEEXT = ".xlsx"


ActiveWorkbook.SaveAs Filename:=FilePathe & DT & WBNAM & myarr(i) & "" & FILEEXT
ActiveWindow.Close
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

---

第一点是定义“文件路径”，然后使用“文件路径”

---

如果文件名类似于book_29，那么您可以使用find来获取下划线的位置，并使用find来获取just book。

选项Explicit会有一些好处here@urdearboy这应该是我一点都不懂的…这不是我的意思：