将多个工作簿合并到一个 Excel 工作簿中

Question

I want to combine the first sheet of multiple workbooks into one master workbook. The data is always structured in the same manner. In addition to this, I want an extra sheet in my master workbook where all the data is summarized (to add up all the numbers of each sheet,eg 1+1+1=3).

So far I started with this code. Yet, I have no idea how to summarize in VBA with different workbooks (that is why it not included in the code)

thanks in advance folks!

'Defining
Dim wb As Workbook
Dim ws As Worksheet
Dim directory As String
Dim myFiles As String
Dim targetwb As Workbook
Set targetwb = ThisWorkbook

Application.ScreenUpdating = False

directory = "C:\Dokumente\"
myFiles = Dir(directory & "*.xlsx")

'Loop through all files in a folder until DIR cannot find anymore

Do While myFiles <> ""

'Open Workbooks one by one 'Do i really have to use the "set command"???
Set wb = Workbooks.Open(Filename:=directory & myFiles)

'The actual action

'Countries:

'Brazil:

If wb.Name = "Brazil*" Then
Worksheets("Status Overview").Copy ThisWorkbook.Worksheets("Brazil")
End If

'Kosovo:

If wb.Name = "Kosovo*" Then
Worksheets("Status Overview").Copy ThisWorkbook.Worksheets("Kosovo")
End If

'United States:

If wb.Name = "United States*" Then
Worksheets("Status Overview").Copy ThisWorkbook.Worksheets("United States")
End If

Workbooks(myFiles).Close

myFiles = Dir

Loop

Application.ScreenUpdating = True```

Answer 1

Run this in a Workbook with one sheet name Summary.

Option Explicit

Sub Summarize()

    Const FOLDER = "C:\Dokumente\"
    Const WS_NAME = "Status Overview"
   
    'Defining
    Dim wbIn As Workbook, wb As Workbook, ws As Worksheet, ar, s
    Dim filename As String, msg As String
    Dim copied As Collection
    Set copied = New Collection

    ar = Array("Brazil", "Kosovo", "United States")
    Set wb = ThisWorkbook
    
    'Application.ScreenUpdating = False
    filename = Dir(FOLDER & "*.xlsx")
    Do While filename <> ""
        For Each s In ar
            If LCase(filename) Like LCase(s) & "*" Then
                Set wbIn = Workbooks.Open(FOLDER & filename, True, True) ' update links, read only
                wbIn.Sheets(WS_NAME).Copy after:=wb.Sheets(wb.Sheets.Count)
                wbIn.Close False
                wb.Sheets(wb.Sheets.Count).Name = s
                copied.Add s
                msg = msg & vbCrLf & s
            End If
        Next
        filename = Dir
    Loop

    ' build =SUM() formula
    Dim f As String, sep As String, rng As Range
   
    f = "=SUM("
    For Each s In copied
        f = f & sep & "'" & s & "'!RC"
        sep = ","
    Next
    f = f & ")"

   ' range to summate on summary sheet
    Set rng = wb.Sheets("Summary").Range("A10:E20")

    ' apply sum formula to range
    rng.FormulaR1C1 = f
   
    'Application.ScreenUpdating = True
    MsgBox "Imported :" & msg, vbInformation

End Sub