Сумма диапазона ячеек листов другой книги по условию.

[Ammat]

Здравствуйте. Помогите реализовать задачу. Есть книга "Сумма" , на листе "Итог" - кнопка. По нажатию кнопки неоходимо открыть книгу "Данные" , посмотреть все листы, и если в ячейке "Н3" есть значение "ПРЖ" , тогда просуммировать диапазон (B9:T21) этих листов .Эту сумму поместить в соответствующий диапазон (B9:T21) листа "Итог" , где кнопка. Книгу "Данные" закрыть без изменений. Кто сможет , прошу помочь. Спасибо.

[Ammat]

Уважаемые профессионалы , посоветуйте что-нибудь.

[Hugo121]

Sub tt()
    Dim sh As Object
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False

        With GetObject(ThisWorkbook.Path & "\" & "Данные.xlsx")
            For Each sh In .Worksheets
                If sh.Range("H3") = "ПРЖ" Then
                    sh.Range("B9:T21").Copy
                    Range("B9").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
                End If
            Next
            .Close 0
        End With

        [a1].Select
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Хотя нет, так глючит.
Надежнее так:

Sub tt()
    Dim sh As Object, r As Range, s$
    s = Range("H3").Value: Set r = Range("B9")
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False

        With Workbooks.Open(ThisWorkbook.Path & "\" & "Данные.xlsx")
            For Each sh In .Worksheets
                If sh.Range("H3") = s Then
                    sh.Range("B9:T21").Copy
                    r.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
                End If
            Next
            .Close 0
        End With

        r.Select
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

"ПРЖ" можно менять на листе.
Но правда тоже иногда выпадает в automation error - видать эта спецвставка дело ненадёжное...

[IgorGO]

Sub AddData()
  Dim sh As Worksheet, shn As String
  Application.ScreenUpdating = False
  With Workbooks.Open(Filename:=ThisWorkbook.Path & Application.PathSeparator & "Данные.xlsx")
    ThisWorkbook.Activate
    For Each sh In .Worksheets
      If sh.Cells(3, 8) = "ПРЖ" Then sh.[B9:T21].Copy: [b9].PasteSpecial xlPasteAll, xlAdd:  shn = shn & ", " & sh.Name
    Next
    Application.CutCopyMode = False: .Close False
    If shn <> "" Then MsgBox "Data from" & Chr(10) & Chr(10) & .FullName & Chr(10) & Right(shn, Len(shn) - 2) & _
      Chr(10) & Chr(10) & "successfully added", vbOKOnly, "Congratulation!!!"
  End With
  Application.ScreenUpdating = True
End Sub

мой совет практически не отличается от предыдущего))

[Ammat]

Спасибо Всем огромное! Буду тестировать.

[Ammat]

Спасибо Вам ,второй код работает хорошо. Проблемма в том , что собранная сумма добавляется к уже существующим данным на листе "Итог".Необходимо добавить в код команду : перед сбором суммы ,очистить диапазон ("B9:T21") на листе "Итог". Спасибо за помощь.

[Hugo121]

Включаете рекордер, очищаете диапазон, выключаете рекордер.
Добавляете код в код

Но если лень - добавьте в начало кода строку

Range("B9:T21").ClearContents

[Ammat]

Добавил r.clearcontents .Диапазон не очищает.

[Hugo121]

Я там ошибся, исправил пост. Вроде через 10 минут уже исправил