VBA to Get SUMMARY of Multipple Sheet

[mag]

Thanks Lalit For the Reply But Still Thats not result i want Please find the attached file and help me to get the result accordingly.

[LalitPandey87]

Thanks Lalit For the Reply But Still Thats not result i want Please find the attached file and help me to get the result accordingly.

Replace previous code with this one

Option Explicit

Private Const strFindItem                   As String = "Item"
Private Const strSummarySheet               As String = "Summary"
Private Const strPvtTblName                 As String = "pvtTemp"
Private Const strPvtTblDesti                As String = "$I$1"

Sub GetSummary()
    
    Dim objWks                      As Worksheet
    Dim rngData                     As Range
    Dim varData()                   As Variant
    Dim lngCount                    As Long
    
    If Application.ScreenUpdating Then Application.ScreenUpdating = False
    
    lngCount = 0
    For Each objWks In ThisWorkbook.Worksheets
        With objWks
            If .Name <> strSummarySheet Then
                lngCount = lngCount + 1
                Set rngData = Nothing
                ReDim varData(0)
                On Error Resume Next
                Set rngData = .Cells.Find(What:=strFindItem, LookIn:=xlValues)
                Set rngData = rngData.CurrentRegion.Offset(-1)
                Set rngData = Intersect(rngData, rngData.Offset(1))
                If WorksheetFunction.Count(rngData) > 0 Then
                    If lngCount = 1 Then
                        varData = rngData.Value
                    ElseIf lngCount > 1 Then
                        Set rngData = Intersect(rngData, rngData.Offset(1))
                        varData = rngData.Value
                    End If
                End If
                On Error GoTo 0: Err.Clear
                If UBound(varData) > 0 Then
                    With ThisWorkbook.Worksheets(strSummarySheet)
                        If lngCount = 1 Then
                            .Range("A1").CurrentRegion.Clear
                            Set rngData = .Range("A1")
                        Else
                            Set rngData = .Range("A1").Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                        End If
                        rngData.Resize(UBound(varData), UBound(varData, 2)).Value = varData
                    End With
                End If
            End If
        End With
    Next objWks
    
    With ThisWorkbook.Worksheets(strSummarySheet)
        varData = InsertPivot(.Range("A1").CurrentRegion)
        .Cells.ClearContents
        If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
        If UBound(varData) > 0 Then
            .Range("A1").Resize(UBound(varData), UBound(varData, 2)).Value = varData
            If LCase(varData(1, 2)) = "values" Then
                .Range("A1").EntireRow.Delete
            End If
            MsgBox "Data summarized successfully.", vbInformation, "Data Summarization"
        Else
            MsgBox "No data available to summarized.", vbInformation, "Data Summarization"
        End If
    End With
    
    
    Set objWks = Nothing
    Set rngData = Nothing
    Erase varData
    lngCount = Empty
    
End Sub


Function InsertPivot(ByVal rngData As Range) As Variant

    Dim varColumnHeader()               As Variant
    Dim lngColumn                       As Long
    
    ReDim varColumnHeader(0)
    
    With ThisWorkbook.Worksheets(strSummarySheet)
        .Range(strPvtTblDesti).CurrentRegion.EntireColumn.Delete Shift:=xlToLeft
    End With
    On Error Resume Next
    varColumnHeader = rngData.Resize(1).Value
    On Error GoTo 0: Err.Clear
    If UBound(varColumnHeader) > 0 Then
        With ThisWorkbook
            Application.DisplayAlerts = False
            .PivotCaches.Create(xlDatabase, rngData).CreatePivotTable .Worksheets(strSummarySheet).Range(strPvtTblDesti), strPvtTblName
            .ShowPivotTableFieldList = True
            Application.DisplayAlerts = True
        End With
        
        With ThisWorkbook.Worksheets(strSummarySheet)
            With .PivotTables(strPvtTblName)
                For lngColumn = LBound(varColumnHeader) + 1 To UBound(varColumnHeader, 2)
                    .PivotFields(strFindItem).Orientation = xlRowField
                    .PivotFields(strFindItem).Position = 1
                    If LCase(varColumnHeader(1, lngColumn)) = "rate" Then
                        .AddDataField .PivotFields(varColumnHeader(1, lngColumn)), "_" & varColumnHeader(1, lngColumn), xlMax
                    Else
                        .AddDataField .PivotFields(varColumnHeader(1, lngColumn)), "_" & varColumnHeader(1, lngColumn), xlSum
                    End If
                Next lngColumn
            End With
            varColumnHeader = .Range(strPvtTblDesti).CurrentRegion.Value
            .Range(strPvtTblDesti).CurrentRegion.Delete Shift:=xlToLeft
            .Range(strPvtTblDesti).Resize(UBound(varColumnHeader), UBound(varColumnHeader, 2)).Value = varColumnHeader
            If LCase(varColumnHeader(1, 2)) = "values" Then
                .Range(strPvtTblDesti).Resize(rngData.Resize(1).Rows.Count, rngData.Resize(1).Columns.Count).Offset(1).Value = rngData.Resize(1).Value
            Else
                .Range(strPvtTblDesti).Resize(rngData.Resize(1).Rows.Count, rngData.Resize(1).Columns.Count).Value = rngData.Resize(1).Value
            End If
            varColumnHeader = .Range(strPvtTblDesti).CurrentRegion.Value
            .Range(strPvtTblDesti).CurrentRegion.Clear
            For lngColumn = LBound(varColumnHeader) To UBound(varColumnHeader, 2) - 1
                varColumnHeader(UBound(varColumnHeader), lngColumn) = ""
            Next lngColumn
        End With
    End If
    InsertPivot = varColumnHeader
    
    Erase varColumnHeader
    lngColumn = Empty

End Function