Суммирование одинаковых файлов в 1

[Parklane1488]

Всем привет
Подскажите, как можно несколько одинаковых файлов с разными данными объединить в один(просуммировать одинаковые позиции) ?
Все исходные файлы лежат в отдельной папке.
Заранее спасибо за ответ.

На данный момент есть такой код, но он не работает:

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
                  (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
                   MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбран файл!"
        GoTo ExitHandler
    End If
    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open FileName:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        x = x + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

[IgorGO]

положите этот

Private Sub CommandButton1_Click()
  Dim dc, a, a2(), r As Long, fn As String
  Set dc = CreateObject("Scripting.Dictionary")
  fn = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xlsx")
  Do While fn <> ""
    With Workbooks.Add(fn)
      a = .Worksheets(1).[a2].CurrentRegion.Value:  .Close
    End With
    For r = 2 To UBound(a, 1)
      If dc.exists(a(r, 1)) Then dc.Item(a(r, 1)) = dc.Item(a(r, 1)) + a(r, 2) Else dc.Add a(r, 1), a(r, 2)
    Next
    fn = Dir
  Loop
  ReDim a2(1 To dc.Count + 1, 1 To 2): a2(1, 1) = a(1, 1): a2(1, 2) = a(1, 2)
  a = dc.keys
  For r = 0 To dc.Count - 1: a2(r + 2, 1) = a(r): Next
  a = dc.items
  For r = 0 To dc.Count - 1: a2(r + 2, 2) = a(r): Next
  Cells.ClearContents
  [a1].Resize(dc.Count + 1, 2).Value = a2
End Sub

в файл в папке с данными и выполните макрос, может это сработает...
(в папке должны находиться только файл с макросом и файлы с данными)

[Parklane1488]

Сообщение от IgorGO

положите этот

Private Sub CommandButton1_Click()
  Dim dc, a, a2(), r As Long, fn As String
  Set dc = CreateObject("Scripting.Dictionary")
  fn = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xlsx")
  Do While fn <> ""
    With Workbooks.Add(fn)
      a = .Worksheets(1).[a2].CurrentRegion.Value:  .Close
    End With
    For r = 2 To UBound(a, 1)
      If dc.exists(a(r, 1)) Then dc.Item(a(r, 1)) = dc.Item(a(r, 1)) + a(r, 2) Else dc.Add a(r, 1), a(r, 2)
    Next
    fn = Dir
  Loop
  ReDim a2(1 To dc.Count + 1, 1 To 2): a2(1, 1) = a(1, 1): a2(1, 2) = a(1, 2)
  a = dc.keys
  For r = 0 To dc.Count - 1: a2(r + 2, 1) = a(r): Next
  a = dc.items
  For r = 0 To dc.Count - 1: a2(r + 2, 2) = a(r): Next
  Cells.ClearContents
  [a1].Resize(dc.Count + 1, 2).Value = a2
End Sub

в файл в папке с данными и выполните макрос, может это сработает...
(в папке должны находиться только файл с макросом и файлы с данными)

Я сохранил Ваш макрос в отдельный лист и поместил его к исходникам(которые нужно объединить)
И после этого выполнил свой макрос, но к сожалению ничего не произошло(((

[IgorGO]

ладно, упростим инструкцию по эксплуатации:
1. распакуйте 3 файла из архива в отдельную папку
2. откройте файл SumMcr.xlsm
3. нажмите кнопку CommandButton1 (собственно она одна в файле)

[Parklane1488]

Сообщение от IgorGO

ладно, упростим инструкцию по эксплуатации:
1. распакуйте 3 файла из архива в отдельную папку
2. откройте файл SumMcr.xlsm
3. нажмите кнопку CommandButton1 (собственно она одна в файле)

Почему то ругается, что я изменил имя файлов.
Ошибку прилагаю в скрине

[IgorGO]

макросу все равно как называються файлы, он будет перебирать все файлы в папке, в которой лежит файл с макросом

Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xlsx")

[Parklane1488]

Сообщение от Parklane1488

Почему то ругается, что я изменил имя файлов.
Ошибку прилагаю в скрине

Всё, ошибку понял свою.
Поправил формат excel файлов.
А у меня ещё вопрос, если нужно будет в этих файлах 3 вкладки складывать(шапка такая же, просто данные за другие периоды будут) как поступить?

[IgorGO]

Private Sub CommandButton1_Click()
  Dim dc, a, a2(), r As Long, fn As String, sh As Worksheet
  Set dc = CreateObject("Scripting.Dictionary")
  fn = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xlsx")
  Do While fn <> ""
    With Workbooks.Add(fn)
      For Each sh In .Worksheets
        a = sh.[a2].CurrentRegion.Value
        For r = 2 To UBound(a, 1)
          If dc.exists(a(r, 1)) Then dc.Item(a(r, 1)) = dc.Item(a(r, 1)) + a(r, 2) Else dc.Add a(r, 1), a(r, 2)
        Next
      Next
      .Close: fn = Dir
    End With
  Loop
  ReDim a2(1 To dc.Count + 1, 1 To 2): a2(1, 1) = a(1, 1): a2(1, 2) = a(1, 2)
  a = dc.keys
  For r = 0 To dc.Count - 1: a2(r + 2, 1) = a(r): Next
  a = dc.items
  For r = 0 To dc.Count - 1: a2(r + 2, 2) = a(r): Next
  Cells.ClearContents
  [a1].Resize(dc.Count + 1, 2).Value = a2
End Sub

[Parklane1488]

Сообщение от IgorGO

Private Sub CommandButton1_Click()
  Dim dc, a, a2(), r As Long, fn As String, sh As Worksheet
  Set dc = CreateObject("Scripting.Dictionary")
  fn = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xlsx")
  Do While fn <> ""
    With Workbooks.Add(fn)
      For Each sh In .Worksheets
        a = sh.[a2].CurrentRegion.Value
        For r = 2 To UBound(a, 1)
          If dc.exists(a(r, 1)) Then dc.Item(a(r, 1)) = dc.Item(a(r, 1)) + a(r, 2) Else dc.Add a(r, 1), a(r, 2)
        Next
      Next
      .Close: fn = Dir
    End With
  Loop
  ReDim a2(1 To dc.Count + 1, 1 To 2): a2(1, 1) = a(1, 1): a2(1, 2) = a(1, 2)
  a = dc.keys
  For r = 0 To dc.Count - 1: a2(r + 2, 1) = a(r): Next
  a = dc.items
  For r = 0 To dc.Count - 1: a2(r + 2, 2) = a(r): Next
  Cells.ClearContents
  [a1].Resize(dc.Count + 1, 2).Value = a2
End Sub

Прошу прощения за неточность в вопросе.
Если допустим 3 вкладки есть в файле и нужно чтобы каждая вкладка считалась вместе с такой же вкладкой в других файлах(то есть Лист 1 с Лист 1, Лист 2 с Лист 2)
И где можно прописать, чтобы он считал не только 1 столбец, а допустим если их будет 12(разбивка к примеру по месяцам будет)?
Ещё такая ситуация. Когда я кладу свои файлы в папку с макросом мне приходится дублировать файлы ещё в папку Мои Документы, так как макрос не видит их почему-то.

[IgorGO]

И где можно прописать, чтобы он считал не только 1 столбец, а допустим...

пишите все в предложенном выше макросе, но... уже без меня, извините