Excel:将多个文件中的工作表动态压缩到一个工作簿中

时间:2014-06-17 22:17:55

标签: excel excel-vba excel-2010 vba

我有大约十个包含相同格式/结构化数据的文件(前四行是信息,第五行是标题,之后的每一行都是数据本身;另外,第一列是空白的,用于保证金目的)。我想将它们全部动态合并到一个工作表中。关于如何做到这一点的任何想法?

1 个答案:

答案 0 :(得分:0)

你不是非常具体,但你可以试试这个。它将文件夹中的所有文件合并为一个。您必须使其适应您拥有的数据(行标题等)。

Sub MergeFiles()
'Description: Combines all files in a folder to a master file.
    Dim path As String
    Dim ThisWB As String
    Dim lngFilecounter As Long
    Dim wbDest As Workbook
    Dim shtDest As Worksheet
    Dim ws As Worksheet
    Dim Filename As String
    Dim Wkb As Workbook
    Dim CopyRng As Range
    Dim Dest As Range
    Dim RowofCopySheet As Integer

    RowofCopySheet = 3 ' Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name

    path = GetFolder("")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Workbooks.Add
    ChDir path
    ActiveWorkbook.SaveAs Filename:= _
        (path & "combinedfilesforfolder.xlsm"), FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), _
                Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If

        Filename = Dir()
    Loop
相关问题