Question

您好我需要通过从目录中选择工作簿来组合工作簿列表。从活动工作簿复制一系列数据并将其粘贴到新的主工作簿中。然后从另一个工作簿复制另一个数据范围以粘贴到新粘贴的单元格旁边。然后我需要在目录中重复多个文件的过程。这是我到目前为止找到的代码：

Option Explicit

'Combine Workbooks
'This sample goes through all the Excel files in a specified directory and combines theminto
'a single workbook.  It renames the sheets based on the name of the original workbook:
Sub CombineSourceWorkbooks()
Dim CurFile As String, DirLoc As String
Dim DestWb As Workbook
Dim wbkOpen As Workbook
Dim WS As Object 'allows for different sheet types

DirLoc = "C:\MyFiles\"
CurFile = Dir(DirLoc & "*.xls")

Application.ScreenUpdating = False
Application.EnableEvents = False

Set DestWb = Workbooks.Add(xlWorksheet)

Do While CurFile <> vbNullString
    Dim OrigWb As Workbook
    Set OrigWb = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)

    ' Limit to valid sheet names and remove .xls*
    CurFile = Left(Left(CurFile, Len(CurFile) - 5), 29)

        OrigWb.Sheets.Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
    'Name the File

        DestWb.Sheets(DestWb.Sheets.Count).Name = CurFile
    'Delete unwanted columns
        DestWb.Sheets(DestWb.Sheets.Count).Range("A:C,H:P").Delete (xlToLeft)
                OrigWb.Close SaveChanges:=False
        CurFile = Dir
       ' Set wbkOpen = Workbooks.Open(DirLoc & CurFile, False, True)




Loop

Application.DisplayAlerts = False
    DestWb.Sheets(1).Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
Application.EnableEvents = True

Set DestWb = Nothing

End Sub

Answer 1

您可以使用此方法。

Sub combine()

    Dim app As New Excel.Application
    app.Visible = False

    Dim wbM As Workbook
    Set wbM = ActiveWorkbook

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = True
    Files = fd.Show

    For i = 1 To fd.SelectedItems.Count
        app.Workbooks.Open fd.SelectedItems(i)
    Next i

    Dim wb As Workbook
    For Each wb In app.Workbooks
        If wb.Name <> "main.xlsb" Then
            Dim wsN As Worksheet
            Set wsN = wbM.Sheets.Add(after:=wbM.Sheets(wbM.Sheets.Count))
            wsN.Name = wb.Name

            wbM.Sheets(wb.Name).Range("A1:K10").Value = wb.Sheets(1).Range("A1:K10").Value

            wb.Close SaveChanges:=False
        End If
    Next

    app.Quit
    Set app = Nothing

End Sub

另外，请尝试下面的AddIn。

http://www.rondebruin.nl/win/addins/rdbmerge.htm

使用范围将Excel工作簿合并到一个主文件副本中

1 个答案: