Bom dia!!

Considerando que os dados começam em A1

Item Inventario Endereço Quantidade
A25 I1 E1 8
A25 I1 E2 7
A25 I2 E3 10
B12 I3 E4 11
B13 I1 E5 3
B59 I1 E6 7
C59 I2 E7 5
C35 I3 E8 6
B12 I1 E9 9
A25 I1 E10 4
C35 I3 E11 2
A25 I2 E12 8
B12 I1 E13 3
B59 I2 E14 7

Tente

Sub AleVBA_18058()

    Worksheets("Sheet1").Range("G1:J" & Rows.Count).ClearContents
    
    With Worksheets("Sheet1")
        .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp)).Copy Worksheets("Sheet1").Range("G1")
    End With
    
    Worksheets("Sheet1").Range("G1:G" & Rows.Count).RemoveDuplicates 1, xlYes
    
    With Cells(1).CurrentRegion.Columns("H")
        .Offset(1).Resize(.Rows.Count - 1).Formula = "=SUMPRODUCT(($A$2:$A$15=G2)*(($B$2:$B$15=""I1"")+($B$2:$B$15=""I2""))*($D$2:$D$15))"
        .Value = .Value
    End With
    
End Sub

Att

... só complementando para eliminar as linhas que contêm zeros abaixo da tabela resultante.

Sub AleVBA_18058_B()

    Worksheets("Sheet1").Range("G1:J" & Rows.Count).ClearContents
    
    With Worksheets("Sheet1")
        .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp)).Copy Worksheets("Sheet1").Range("G1")
    End With
    
    Worksheets("Sheet1").Range("G1:G" & Rows.Count).RemoveDuplicates 1, xlYes
    
    With Cells(1).CurrentRegion.Columns("H")
        .Offset(1).Resize(WorksheetFunction.CountA(Worksheets("Sheet1").Columns("G")) - 1).Formula = _
                "=SUMPRODUCT(($A$2:$A$15=G2)*(($B$2:$B$15=""I1"")+($B$2:$B$15=""I2""))*($D$2:$D$15))"
        .Value = .Value
    End With
    
    Worksheets("Sheet1").Range("H1") = "Quantidade"
    
    Worksheets("Sheet1").Columns("G:G").Copy
    Worksheets("Sheet1").Columns("H:H").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Worksheets("Sheet1").Columns("G:H").AutoFit
    
    With Worksheets("Sheet1").Range("G1").CurrentRegion
        .Borders.LineStyle = xlNone
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
    Worksheets("Sheet1").Range("A1").Select
    
    MsgBox "OK"
    
End Sub

Nelson,

primeiramente obrigado pela disposição.

Mas a primeira linha está repetindo o A25, porquê?

Outra coisa, na minha planilha original, tenho 3 abas diferentes de onde vou pegar os dados, isso muda o codigo ?

Se você vai extrair os dados de três planilhas (Plan) ao invés de uma única planilha, o código muda sim.

Melhor você disponibilizar um arquivo já com os nomes das três planilhas e a planilha onde devem ser resumidos os valores.

Assim não vai ser preciso fazer nenhum ajuste depois.

Nelson,

segue em anexo.
Os dados de item e disponível devem sair do estoque (filtrando conforme explicado anteriormente), e o de demanda deve sair da de demanda (creio que é mais simples).
Lembrando que são planilhas com milhares de linhas.

Agradeço desde já !

Bom dia!!

Eu não sei se entendi, mas vamos lá.

Adicione uma guia para teste, use o nome AleVBA.

Sub AleVBA_18058V2()
Dim ws As Worksheet, wsAleVBA As Worksheet

Set wsAleVBA = Sheets("AleVBA")
Application.ScreenUpdating = False
    wsAleVBA.Range("A2:A" & Rows.Count).EntireRow.Clear
    For Each ws In Worksheets
        If ws.Name <> "Análise" And _
           ws.Name <> "AleVBA" Then _
           ws.Range("A2:A50000").Copy wsAleVBA.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next ws
    wsAleVBA.[A1].CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    
    With Cells(1).CurrentRegion.Columns("B")
        .Offset(1).Resize(WorksheetFunction.CountA(Worksheets("Estoque").Columns("B")) - 1).Formula = _
        "=IF(A2="""","""",SUMPRODUCT((Estoque!$A$2:$A$1000=A2)*((Estoque!$B$2:$B$1000=""I1"")+(Estoque!$B$2:$B$1000=""I2""))*(Estoque!$D$2:$D$1000)))"
        .Value = .Value
    End With
    Sheets("Demanda").Range("A2:B50000").Copy wsAleVBA.Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
    With Cells(1).CurrentRegion.Columns("E")
        .Offset(1).Resize(WorksheetFunction.CountA(Worksheets("Estoque").Columns("B")) - 1).Formula = _
        "=IF(A2="""","""",D2-B2)"
        .Value = .Value
        .AutoFilter field:=1, Criteria1:=""
        .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
    End With
    Columns("C").Delete
    ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Att

Alexandre, muito obrigado pela ajuda.
Mas dessa forma ela vai criar em uma aba nova, sem a formatação da primeira aba, correto ? Eu preciso que fique naquele formato, pois é o que está na minha planilha.
Se não for pedir muito, você poderia colocar como comentário o que é cada etapa do código para eu tentar entender?

Obrigado!!

Boa tarde!!!

Veja comentários.

Sub AleVBA_18058V2()
Dim ws As Worksheet, wsAleVBA As Worksheet

Set wsAleVBA = Sheets("AleVBA") 'Usa essa aba como referencia para efetuar algumas ações, mude a para o nome que desejar
Application.ScreenUpdating = False
    wsAleVBA.Range("A2:A" & Rows.Count).EntireRow.Clear 'Limpa os dados da guia chave: wsAleVBA
    For Each ws In Worksheets 'Loop para copiar Itens das duas guias conforme abaixo
        If ws.Name <> "Análise" And _
           ws.Name <> "AleVBA" Then _
           ws.Range("A2:A50000").Copy wsAleVBA.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next ws
    'Remove os dados duplicados
    wsAleVBA.[A1].CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    'Inseri uma formula para somar conforme criterio de I1 e I2, cola valores
    With Cells(1).CurrentRegion.Columns("B")
        .Offset(1).Resize(WorksheetFunction.CountA(Worksheets("Estoque").Columns("B")) - 1).Formula = _
        "=IF(A2="""","""",SUMPRODUCT((Estoque!$A$2:$A$1000=A2)*((Estoque!$B$2:$B$1000=""I1"")+(Estoque!$B$2:$B$1000=""I2""))*(Estoque!$D$2:$D$1000)))"
        .Value = .Value
    End With
    'Copia os dados de uma Guia para outra
    Sheets("Demanda").Range("A2:B50000").Copy wsAleVBA.Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
    'Insere uma formula cola valores, deleta valores não aproveitavéis
    With Cells(1).CurrentRegion.Columns("E")
        .Offset(1).Resize(WorksheetFunction.CountA(Worksheets("Estoque").Columns("B")) - 1).Formula = _
        "=IF(A2="""","""",D2-B2)"
        .Value = .Value
        .AutoFilter field:=1, Criteria1:=""
        .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
    End With
    'Delelta a coluna C
    Columns("C").Delete
    ActiveSheet.AutoFilterMode = False 'Remove Filtro
Application.ScreenUpdating = True
End Sub

Quanto a guia altere o nome
De:

Set wsAleVBA = Sheets("AleVBA")

Para:

Set wsAleVBA = Sheets("NomeDaGuia")

Essa parte

 ws.Name <> "AleVBA" Then _

Para

 ws.Name <> "NomeDaGuia" Then _

Obs: Há postagens que eu mesmo respondi, de como inserir a borda completa em torno da célula, use a pesquisa do fórum!

Att

A idéia é basicamente a mesma, só muda um pouco a maneira de codificar. Dá uma testada aí...