Question

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

我需要一些东西让这段代码中的每个文件都保存在不同的地方，具体取决于代码用来将数据与原始工作表分开的过滤器名称。

例如：如果过滤器“book”中的名称我希望文件保存在带有“book”名称的文件夹中，如果过滤器名称是“story”，我希望文件保存在带有“story”名称的文件夹中......等

我将附上我的代码

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

Answer 1

首先，您要定义“filepath”，然后使用“filepathe”......

如果文件名类似于book_29那么你可以使用find（）来获取下划线的位置，使用find（）来使用left（）来获得书籍。

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

1 个答案: