modified code impoting data from multiple sheets with merge duplicate items

[abdelfattah]

hello

first I would thank MR.Zot for provide help me about this thread how make this code more dynamically (loop all files in the same directory )
this is the whole code

Option Explicit
Option Compare Text

Sub CopySheetToClosedWB()

LoopAllFolderAndSub ("C:\Users\PC WORLD\Desktop\")

End Sub

Sub LoopAllFolderAndSub(ByVal FPath As String)

Dim FName As String, FullFPath As String
Dim Note As String, Folds() As String, ArryName() As String
Dim i As Long, nFold As Long
Dim wsName As Variant
Dim wsNotFound As Boolean
Dim ws As Worksheet, SourceSht As Worksheet
Dim wb As Workbook, ClosedBook As Workbook
Dim dName As Object

Set dName = CreateObject("Scripting.Dictionary")
Set ClosedBook = ActiveWorkbook
Set SourceSht = ClosedBook.Sheets("rs")

Application.ScreenUpdating = False

ArryName = Split("sh1,imp,ex,ret", ",")
If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
FName = Dir(FPath & "*.*", vbDirectory)

While Len(FName) <> 0
    If Left(FName, 1) <> "." Then
        FullFPath = FPath & FName
        If (GetAttr(FullFPath) And vbDirectory) = vbDirectory Then
            ReDim Preserve Folds(0 To nFold) As String
            Folds(nFold) = FullFPath
            nFold = nFold + 1
        Else
            If Not FName = ClosedBook.Name Then
                Set wb = Workbooks.Open(FullFPath, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
                Note = ""
                dName.RemoveAll
                For Each wsName In ArryName
                    For Each ws In wb.Sheets
                        If wsName = ws.Name Then
                            dName.Add wsName, Nothing
                            On Error Resume Next
                            Application.DisplayAlerts = False
                            ClosedBook.Sheets(ws.Name).Delete
                            Err.Clear
                            Application.DisplayAlerts = False
                            On Error GoTo 0
                            Set ws = wb.Sheets(ws.Name)
                            ws.Copy After:=ClosedBook.Sheets("rs")
                            Exit For
                        End If
                    Next
                Next
                For Each wsName In ArryName
                    If Not dName.Exists(wsName) Then Note = Note & wsName & ", "
                Next
                    If Len(Note) > 0 Then
                        MsgBox "Missing in " & vbLf & wb.Name & ": " & vbLf & vbLf & Left(Note, Len(Note) - 2)
                    End If
                wb.Close False
            End If
        End If
    End If
    FName = Dir()
Wend

For i = 0 To nFold - 1
    LoopAllFolderAndSub Folds(i)
Next i
ClosedBook.Close True

End Sub

now I want modified code with merge duplicate items based on column B . the column C,D contain invoice number , customer number like this(BBS1/09-001),(CL-BSN1/AT-001)
so when repeate th item in COL B for many times with differnt numbers invoices and customers . should merge in columns C,D should be like this (BBS1/09-001,002) , (CL-BSN1/AT-001,002)
about the summing values in COL H,I,J . the column H should summing repeated values , COL I should not summing . should calculate average price , COL J should multiply COL H xCOL J for each sheets as in code . so the range in all of the sheets begins from A2:J ,A1:J1 is headers
if this is not clear . just tell me may I issue picture to understand it . so I truly appreciate if Zot or any body has knowladge in vba support me
thanks in advance

 

[abdelfattah]

any idea?