时间戳

首页 > 解决方案 > VBA根据过滤结果创建excel文件

excel - VBA根据过滤结果创建excel文件

问题描述

在尝试进行相对简单的自动化工作时，我遇到了一个问题。背后的想法是过滤表格的字段，复制所有可见结果，将它们粘贴到新工作表中，将过滤后的值作为文件名保存新工作表，关闭新文件并重复直到我的列表结束。请帮忙！

这也是我的代码：

Dim ws As Worksheet
Dim y As Integer

Set ws = ThisWorkbook.Worksheets("Restructure_F")
y = 2

Do While Not IsEmpty(Cells(26, y).Value)

ws.Range("A1").AutoFilter Field:=15, Criteria1:=Cells(26, y).Value

ws.Range("A1:O2486").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

Workbooks.Add.Worksheets(1).Paste

ActiveWorkbook.SaveAs Filename:="C:\tools\Output\" & Cells(2, 13).Value

ActiveWorkbook.Close True

y = y + 1
Loop


End Sub

标签： excelvba

解决方案

我在你的代码中添加了一些车道。如果我理解您的描述，它会按您的意愿工作。

Sub test()
Dim ws As Worksheet
Dim y As Integer
'   save variable
Dim sPath As String
Dim TempWb As Workbook
Dim TempWs As Worksheet
Set ws = ThisWorkbook.Worksheets("Restructure_F")
y = 2

Do While Not IsEmpty(ws.Cells(26, y).Value)
    ws.Range("A1").AutoFilter Field:=15, Criteria1:=ws.Cells(26, y).Value
    ws.Range("A1:O2486").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
    sPath = "C:\tools\Output\" & ws.Cells(26, y).Text & ".xlsx"
    Set TempWb = Workbooks.Add
    Set TempWs = TempWb.Worksheets(1)
    TempWs.Range("A1").PasteSpecial
    TempWb.SaveAs Filename:=sPath
    TempWb.Close True
    Set TempWb = Nothing
    ws.Range("A1").AutoFilter
    y = y + 1
Loop
End Sub

推荐阅读