Excel宏自动生成数据并保存文件

时间:2018-09-28 09:17:18

标签: excel vba excel-vba save-as file-generation

我有一个Excel宏,它可以过滤并从另一个工作簿中获取数据,并将其另存为我提到的路径中。

现在,我需要宏对特定文件夹中的整个列表执行相同的操作。我的意思是,它应该根据所有代码的命名约定自动生成数据并保存文件。

有人可以帮我吗?

Sub BringData()

Sheets("FBL Data").Select
    Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A3").Select


    Dim fNameAndPath$
    Dim wsData As Worksheet, wsMacro As Worksheet
    Dim wbMacro As Workbook

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set wsMacro = ThisWorkbook.Sheets("FBL Data")

    MsgBox "File should be in name Blue Print Data Dump.xlsm"
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSM), *.XLSM", Title:="Select File To Be Opened")
    If Len(fNameAndPath) = 0 Then Exit Sub
    Set wbMacro = Workbooks.Open(fNameAndPath)
    Set wsData = wbMacro.Sheets("Data")

    With wsMacro
        .Range("BA1") = .Range("F2"): .Range("BA2") = .Range("A1")
        wsData.Range("A1").CurrentRegion.AdvancedFilter 2, _
            .Range("BA1:BA2"), .Range("A2", .Range("A2").End(xlToRight))
        .Range("BA1:BA2").ClearContents
    End With

    wbMacro.Close False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True


Sheets("Summary").Select
ThisFile = Range("E1").Value
Filename = Range("F1").Value

ActiveWorkbook.SaveAs Filename:=ThisFile
'Open and close the files
currentfile = Range("E1").Value & ".xlsm"
MsgBox ("Macro has been completed for " & Filename)

End Sub

0 个答案:

没有答案