Question

我对此并不陌生，正在尝试学习VBA。我正在尝试创建一个宏； -将自动过滤器放在数据表上 -遍历第9列中的所有条件 -复制数据并将其另存为新工作簿到文件夹 -使用过滤条件作为工作簿的名称

这里的任何帮助将不胜感激。

Answer 1

Sub SplitFile()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim rng1 As Range
Dim last As Long
Dim sht As String
Dim newBook As Excel.Workbook
Dim Workbk As Excel.Workbook

Dim dir As String
    dir = Range("F12").Value

'Specify sheet name in which the data is stored
Sheets("Data").Select
sht = "Data"

'Workbook where VBA code resides
Set Workbk = ThisWorkbook

'filter column
last = Workbk.Sheets(sht).Cells(Rows.Count, "I").End(xlUp).Row

With Workbk.Sheets(sht)
Set rng = .Range("A1:M" & last)
End With

Workbk.Sheets(sht).Range("I1:M" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
For Each x In Workbk.Sheets(sht).Range([AA2], Cells(Rows.Count, "AA").End(xlUp))

If Not GetWorksheet(x.Text) Is Nothing Then
Sheets(x.Text).Delete
End If

With rng



.AutoFilter
.AutoFilter Field:=9, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

Workbooks.Add
ActiveSheet.Paste
    Range("A1").Select
    Columns("A:M").Select
    Columns("A:M").EntireColumn.AutoFit
    Range("A1").Select

    Dim Path1 As String

    Dim myfilename As String

    myfilename1 = Range("E2")
    myfilename = Range("I2")


    ActiveWorkbook.SaveAs Filename:=dir & "\" & myfilename1 & " - " & myfilename & ".xls", FileFormat:=xlNormal

    ActiveWorkbook.Close

End With
Next x


' Turn off filter
Workbk.Sheets(sht).AutoFilterMode = False

    Sheets("Control").Select

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

Excel VBA遍历过滤器条件并将数据另存为新工作簿

1 个答案: