Question

我是VBA的新手，我想知道如何使用VBA合并多个选定的Excel文件。我尝试编码选择文件的部分。我研究并尝试在互联网上复制代码并进行一些编辑。我了解到你可以添加过滤器，所以我这样做了。但有时候，即使我添加了正确的过滤器（基于我研究的内容），excel文件也不会显示。我真的需要合并多个选定的Excel文件。我希望你能帮助我。

我正在使用用户形式，顺便说一句。一个按钮，允许选择和合并所选文件。如果可能，我希望用户看到所选文件的路径。我还不知道如何做到这一点，或者我应该使用什么工具，如列表框或什么。提前谢谢！

更新！

我有一个用于选择多个excel文件的代码。我现在需要的是如何合并我选择的文件。

Dim FileNames As Variant
  Dim Msg As String
  Dim I As Integer
  FileNames = Application.GetOpenFilename(MultiSelect:=True)
  If IsArray(FileNames) Then
      Msg = "You selected:" & vbNewLine
      For I = LBound(FileNames) To UBound(FileNames)
          Msg = Msg & FileNames(I) & vbNewLine
      Next I
      MsgBox Msg
      tbPath.Value = Msg
  Else
      MsgBox "No files were selected."
  End If

Answer 1

这是我的代码......希望这能帮到你。

    Sub mergeAllFiles()

    Dim This As Workbook 'Store the book with the macro
    Dim TmpB As Workbook 'store the book that has the sheets (one per book)
    Dim AllB As Workbook 'book to send all the books
    Dim sht As Worksheet 'the only sheet every book

    Dim FileNames As Variant
    Dim Msg As String
    Dim I As Integer

    Set This = ThisWorkbook
    FileNames = Application.GetOpenFilename(MultiSelect:=True)
    If IsArray(FileNames) Then
        Workbooks.Add 'add a new book to store all the sheets
        Set AllB = ActiveWorkbook
        AllB.SaveAs This.Path & "\allSheetsInOne" & SetTimeName & ".xlsx", 51
        'The function is to store a different name every time and avoid error
        Msg = "You selected:" & vbNewLine

        For I = LBound(FileNames) To UBound(FileNames)
            Workbooks.Open Filename:=FileNames(I)
            Set TmpB = ActiveWorkbook
            TmpB.Activate
            Set sht = ActiveSheet 'because you say that the book has only one sheet
            sht.Copy Before:=AllB.Sheets(Sheets.Count) 'send it to the end of the sheets
            TmpB.Close 'we don't need the book anymore
            Set TmpB = Nothing 'empty the var to use it again
            Set sht = Nothing
            Msg = Msg & FileNames(I) & vbNewLine
        Next I
        MsgBox Msg
        tbPath.Value = Msg
    Else
        MsgBox "No files were selected."
    End If
End Sub


Function SetTimeName()
Dim YY
Dim MM
Dim DD
Dim HH
Dim MI
Dim SS
Dim TT

YY = Year(Date)
MM = Month(Date)
DD = Day(Date)
HH = Hour(Now)
MI = Minute(Now)
SS = Second(Now)

TT = Format(YY, "0000") & Format(MM, "00") & Format(DD, "00") & Format(HH, "00") & Format(MI, "00") & Format(SS, "00")

SetTimeName = TT
End Function

告诉我是否需要改进。

Answer 2

使用我的代码：

Multi-Select Files and open

编辑代码以满足您的要求。

Sub OPenMultipleWorkbooks()
'Open Multiple .xlsx files
    Application.DisplayAlerts = False
    Dim wb As Workbook, bk As Workbook
    Dim sh As Worksheet
    Dim GetFile As Variant, Ws As Worksheet

    Set wb = ThisWorkbook
    Set sh = wb.ActiveSheet

    For Each Sheet In Sheets
        If Sheet.Name <> sh.Name Then Sheet.Delete
    Next Sheet

    ChDrive "C:"
    Application.ScreenUpdating = False

    GetFile = Application.GetOpenFilename(FileFilter:="XLSX(*.xlsx), *.xlsx", Title:="Open XLSX- File", MultiSelect:=True)

    On Error Resume Next

    If GetFile <> False Then

        On Error GoTo 0

        For i = 1 To UBound(GetFile)

            Set bk = Workbooks.Open(GetFile(i))
            Sheets(1).Move Before:=wb.Sheets(1)
            bk.Close True
        Next i

    End If

End Sub

如何在VBA中合并多个选定的Excel文件？

2 个答案:

使用我的代码：