Dear My Master ,I Want Your Help To Extract Column A & Column B From all WorkBook Sheets To Summary Sheet Without repetition
Code:
Sub GetNames()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, C As Range
Dim LS As Long, p As Long, Obj As Object
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(2).Row
Sh.Range("B2:B" & LS) = ""
Set Obj = CreateObject("scripting.dictionary")
For Each ws In Worksheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
If ws.Name <> Sh.Name Then
LR = ws.Range("B" & Rows.Count).End(2).Row - 1
For Each C In ws.Range("B2:B" & LR)
If Not IsEmpty(C) Then Obj(C & "") = ""
Next
End If
Next
Sh.Range("b2:B2").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
Call SumIf_Valus
End Sub
Sub SumIf_Valus()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long
Dim Arc As Variant, Arr As Variant
Dim LS As Long, j As Long, x As Double
Dim SupNam As String
Application.ScreenUpdating = False
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
If LS < 2 Then LS = 2
Arc = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
Arr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
j = 2
Do While j <= LS
SupNam = Sh.Range("B" & j)
For i = LBound(Arr) To UBound(Arr)
For Each ws In Worksheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
LR = ws.Range("B" & Rows.Count).End(2).Row
If LR < 2 Then LR = 2
x = x + WorksheetFunction.SumIf(ws.Range("B2:B" & LR), SupNam, _
ws.Range(ws.Cells(2, Arr(i)), ws.Cells(LR, Arr(i))))
Sh.Range(Arc(i) & j) = x
Next
x = 0
Next
j = j + 1
Loop
Application.ScreenUpdating = True
End Sub