Extraction same sheet name from files in folder and merge the same price

[abdo meghari]

Hello,
I would macro, not POWER QUERY to extract the whole sheets from files are existed in directory D:\ab\INVOICES
so every file contains one sheet , the same sheet name .

INV1.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	4.00	500.00	2,000.00
23	2	VEGA 55A R KOR	2.00	425.00	850.00
24	3	LARGEST 60A L HIGH JAP	2.00	440.00	880.00
25	4	KM 215/65R16 TA31 KOR	4.00	460.00	1,840.00
26	5	265/70R16 ALGERIA	4.00	630.00	2,520.00
27	6	KM 205/65R16 HS63 KOR	4.00	445.00	1,780.00
28	7	GC 385/65R22.5 AT131 CHI	2.00	1,650.00	3,300.00
29	8	KM 265/70R16 KOR	4.00	880.00	3,520.00
30	9	DONGA 66A L KOR	2.00	460.00	920.00
31	10	KM 235/65R17 HP71 KOR	4.00	625.00	2,500.00
32	11	KM 235/55R19 PS71 KOR	4.00	675.00	2,700.00
33	12	DROUB 90A L KOR	1.00	575.00	575.00
34	13	KM 13R22.5 MA11 KOR	2.00	2,550.00	5,100.00
35	TOTAL		39.00		28,485.00
SH1

Cell Formulas
Range	Formula
D35,F35	D35	=SUM(D22:D34)
F22:F34	F22	=E22*D22

INV2.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	1.00	500.00	500.00
23	2	VEGA 55A R KOR	2.00	425.00	850.00
24	3	LARGEST 60A L HIGH JAP	2.00	440.00	880.00
25	4	KM 215/65R16 TA31 KOR	1.00	460.00	460.00
26	5	265/70R16 ALGERIA	4.00	630.00	2,520.00
27	6	KM 205/65R16 HS63 KOR	4.00	450.00	1,800.00
28	7	GC 385/65R22.5 AT131 CHI	12.00	1,640.00	19,680.00
29	8	KM 265/70R16 KOR	4.00	880.00	3,520.00
30	9	KM 235/65R17 HP71 KOR	1.00	875.00	875.00
31	10	KM 235/55R19 PS71 KOR	2.00	670.00	1,340.00
32	TOTAL		33.00		32,425.00
SH1

Cell Formulas
Range	Formula
D32,F32	D32	=SUM(D22:D31)
F22:F31	F22	=E22*D22

INV3.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	BJS 13R22.5 MA11 KOR	10.00	2,555.00	25,550.00
23	2	KM 13R22.5 MA11 KOR	12.00	2,000.00	24,000.00
24	TOTAL		22.00		49,550.00
SH1

Cell Formulas
Range	Formula
D24,F24	D24	=SUM(D22:D23)
F22:F23	F22	=D22*E22

so the result in OUTPUT file into result sheet will already be existed and rename sheet for each file contains same sheet name based on file name INV1,INV2,INV3 before RESULT sheet. after data copy the data from sheets and merge QTY in column D for each brand IN COLUMN C if the price is the same thing in column E for duplicates brands whether in the same sheet or all of sheets across files otherwise don't merge , surely without forget insert TOTAL row to sum amounts.


before

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22
23
24
25
26
27
28
RESULT

after

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	5	500.00	2,500.00
23	2	VEGA 55A R KOR	4	425.00	1,700.00
24	3	LARGEST 60A L HIGH JAP	4	440.00	1,760.00
25	4	KM 215/65R16 TA31 KOR	5	460.00	2,300.00
26	5	265/70R16 ALGERIA	8	630.00	5,040.00
27	6	KM 205/65R16 HS63 KOR	4	445.00	1,780.00
28	7	GC 385/65R22.5 AT131 CHI	2	1,650.00	3,300.00
29	8	KM 265/70R16 KOR	8	880.00	7,040.00
30	9	DONGA 66A L KOR	2	460.00	920.00
31	10	KM 235/65R17 HP71 KOR	4	625.00	2,500.00
32	11	KM 235/55R19 PS71 KOR	4	675.00	2,700.00
33	12	DROUB 90A L KOR	1	575.00	575.00
34	13	KM 13R22.5 MA11 KOR	2	2,550.00	5,100.00
35	14	KM 205/65R16 HS63 KOR	4	450.00	1,800.00
36	15	GC 385/65R22.5 AT131 CHI	12	1,640.00	19,680.00
37	16	KM 235/65R17 HP71 KOR	1	875.00	875.00
38	17	KM 235/55R19 PS71 KOR	2	670.00	1,340.00
39	18	BJS 13R22.5 MA11 KOR	10	2,555.00	25,550.00
40	19	KM 13R22.5 MA11 KOR	12	2,000.00	24,000.00
41	TOTAL		94		110,460.00
RESULT

Cell Formulas
Range	Formula
D41,F41	D41	=SUM(D22:D40)

every time when run macro should delete sheets before RESULT sheet also delete data in RESULT sheet before brings data.
thanks

 

[mumps]

Place this macro in a regular module in the "OUTPUT" workbook.

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim lRow As Long, dic As Object, v As Variant, i As Long, desWS As Worksheet, srcWB As Workbook, val As String, fnd As Range
    Set desWS = ThisWorkbook.Sheets("RESULT")
    Const strPath As String = "D:\ab\INVOICES\"
    ChDir strPath
    strExtension = Dir(strPath & "INV*.xlsm")
    Set dic = CreateObject("Scripting.Dictionary")
    Do While strExtension <> ""
        If strExtension Like "INV*" Then
            Set srcWB = Workbooks.Open(strPath & strExtension)
            With srcWB.Sheets("SH1")
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                v = .Range("C22:C" & lRow - 1).Resize(, 3).Value
                For i = LBound(v) To UBound(v)
                    val = v(i, 1) & "|" & v(i, 3)
                    If Not dic.exists(val) Then
                        dic.Add val, v(i, 2)
                        With desWS
                            .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Resize(, 3).Value = Array(v(i, 1), v(i, 2), v(i, 3))
                        End With
                    Else
                        With desWS
                            Set fnd = .Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                            .Range("C" & fnd.Row).Resize(, 3).Value = Array(v(i, 1), v(i, 2) + dic(val), v(i, 3))
                        End With
                    End If
                Next i
                srcWB.Close savechanges:=False
            End With
        End If
        strExtension = Dir
    Loop
    With desWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("B22").Value = "1"
        .Range("B22").AutoFill Destination:=.Range("B22").Resize(lRow - 21), Type:=xlFillSeries
        .Range("B" & lRow + 1) = "TOTAL"
        .Range("F22:F" & lRow).Formula = "=D22*E22"
        .Range("D" & lRow + 1).Formula = "=sum(D22:D" & lRow & ")"
        .Range("F" & lRow + 1).Formula = "=sum(F22:F" & lRow & ")"
        .Range("E22:F" & lRow + 1).NumberFormat = "#,##0.00"
    End With
    Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

thanks,
but shows error AutoFill method of the Range class failed in this line

.Range("B22").AutoFill Destination:=.Range("B22").Resize(lRow - 21), Type:=xlFillSeries

 

[mumps]

When I tested the macro using the data you posted, it worked with no error. Are you using the macro with the same data?

 

[abdo meghari]

yes , I will check again .

 

[abdo meghari]

Ok I see my bad !
extension xlsm excel in OP and I use with xls .

I forgot the sheets should add before result sheet for every file
the result in OUTPUT file should add sheets before combine data in RESULT sheet like this

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	4	500.00	2,000.00
23	2	VEGA 55A R KOR	2	425.00	850.00
24	3	LARGEST 60A L HIGH JAP	2	440.00	880.00
25	4	KM 215/65R16 TA31 KOR	4	460.00	1,840.00
26	5	265/70R16 ALGERIA	4	630.00	2,520.00
27	6	KM 205/65R16 HS63 KOR	4	445.00	1,780.00
28	7	GC 385/65R22.5 AT131 CHI	2	1,650.00	3,300.00
29	8	KM 265/70R16 KOR	4	880.00	3,520.00
30	9	DONGA 66A L KOR	2	460.00	920.00
31	10	KM 235/65R17 HP71 KOR	4	625.00	2,500.00
32	11	KM 235/55R19 PS71 KOR	4	675.00	2,700.00
33	12	DROUB 90A L KOR	1	575.00	575.00
34	13	KM 13R22.5 MA11 KOR	2	2,550.00	5,100.00
35	TOTAL		39		28,485.00
INV1

Cell Formulas
Range	Formula
D35,F35	D35	=SUM(D22:D34)
F22:F34	F22	=E22*D22

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	1	500.00	500.00
23	2	VEGA 55A R KOR	2	425.00	850.00
24	3	LARGEST 60A L HIGH JAP	2	440.00	880.00
25	4	KM 215/65R16 TA31 KOR	1	460.00	460.00
26	5	265/70R16 ALGERIA	4	630.00	2,520.00
27	6	KM 205/65R16 HS63 KOR	4	450.00	1,800.00
28	7	GC 385/65R22.5 AT131 CHI	12	1,640.00	19,680.00
29	8	KM 265/70R16 KOR	4	880.00	3,520.00
30	9	KM 235/65R17 HP71 KOR	1	875.00	875.00
31	10	KM 235/55R19 PS71 KOR	2	670.00	1,340.00
32	TOTAL		33		32,425.00
INV2

Cell Formulas
Range	Formula
D32,F32	D32	=SUM(D22:D31)
F22:F31	F22	=E22*D22

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	BJS 13R22.5 MA11 KOR	10	2,555.00	25,550.00
23	2	KM 13R22.5 MA11 KOR	12	2,000.00	24,000.00
24	TOTAL		22		49,550.00
INV3

Cell Formulas
Range	Formula
D24,F24	D24	=SUM(D22:D23)
F22:F23	F22	=D22*E22

OUTPUT.xlsm
	B	C	D	E	F
21	ITEM	BRAND	QTY	PRICE	BALANCE
22	1	VEGA 70A R KOR	5	500.00	2,500.00
23	2	VEGA 55A R KOR	4	425.00	1,700.00
24	3	LARGEST 60A L HIGH JAP	4	440.00	1,760.00
25	4	KM 215/65R16 TA31 KOR	5	460.00	2,300.00
26	5	265/70R16 ALGERIA	8	630.00	5,040.00
27	6	KM 205/65R16 HS63 KOR	4	445.00	1,780.00
28	7	GC 385/65R22.5 AT131 CHI	2	1,650.00	3,300.00
29	8	KM 265/70R16 KOR	8	880.00	7,040.00
30	9	DONGA 66A L KOR	2	460.00	920.00
31	10	KM 235/65R17 HP71 KOR	4	625.00	2,500.00
32	11	KM 235/55R19 PS71 KOR	4	675.00	2,700.00
33	12	DROUB 90A L KOR	1	575.00	575.00
34	13	KM 13R22.5 MA11 KOR	2	2,550.00	5,100.00
35	14	KM 205/65R16 HS63 KOR	4	450.00	1,800.00
36	15	GC 385/65R22.5 AT131 CHI	12	1,640.00	19,680.00
37	16	KM 235/65R17 HP71 KOR	1	875.00	875.00
38	17	KM 235/55R19 PS71 KOR	2	670.00	1,340.00
39	18	BJS 13R22.5 MA11 KOR	10	2,555.00	25,550.00
40	19	KM 13R22.5 MA11 KOR	12	2,000.00	24,000.00
41	TOTAL		94		110,460.00
RESULT

Cell Formulas
Range	Formula
D41,F41	D41	=SUM(D22:D40)

sorry about missed details in OP
I hope you can modify the code.

 

[abdo meghari]

shouldn't repeat copying to the bottom that what I notice the code does it .
as I mentioned

every time when run macro should delete sheets before RESULT sheet also delete data in RESULT sheet before brings data.

 

[mumps]

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim lRow As Long, dic As Object, v As Variant, i As Long
    Dim desWB As Workbook, desWS As Worksheet, srcWB As Workbook, val As String, fnd As Range
    Set desWB = ThisWorkbook
    Set desWS = desWB.Sheets("RESULT")
    With desWS.UsedRange
        .Offset(1).ClearContents
        .Borders.LineStyle = xlNone
    End With
    Const strPath As String = "D:\ab\INVOICES\"
    strExtension = Dir(strPath & "INV*.xlsm")
    Set dic = CreateObject("Scripting.Dictionary")
    Do While strExtension <> ""
        If strExtension Like "INV*" Then
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Sheets("SH1").Copy before:=desWB.Sheets("RESULT")
            ActiveSheet.Name = Left(srcWB.Name, 4)
            srcWB.Close savechanges:=False
            With ActiveSheet
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                v = .Range("C22:C" & lRow - 1).Resize(, 3).Value
                For i = LBound(v) To UBound(v)
                    val = v(i, 1) & "|" & v(i, 3)
                    If Not dic.exists(val) Then
                        dic.Add val, v(i, 2)
                        With desWS
                            .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Resize(, 3).Value = Array(v(i, 1), v(i, 2), v(i, 3))
                        End With
                    Else
                        With desWS
                            Set fnd = .Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                            .Range("C" & fnd.Row).Resize(, 3).Value = Array(v(i, 1), v(i, 2) + dic(val), v(i, 3))
                        End With
                    End If
                Next i
            End With
        End If
        strExtension = Dir
    Loop
    desWS.Activate
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("B22").Value = "1"
    Range("B22").AutoFill Destination:=Range("B22").Resize(lRow - 21), Type:=xlFillSeries
    Range("B" & lRow + 1) = "TOTAL"
    Range("F22:F" & lRow).Formula = "=D22*E22"
    Range("D" & lRow + 1).Formula = "=sum(D22:D" & lRow & ")"
    Range("F" & lRow + 1).Formula = "=sum(F22:F" & lRow & ")"
    Range("E22:F" & lRow + 1).NumberFormat = "#,##0.00"
    ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
    Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

thanks , but when run the code every time should delete sheets before result sheet before add sheets again
the code will shows error about sheets names have already existed .

 

[mumps]

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim lRow As Long, dic As Object, v As Variant, i As Long, ws As Worksheet
    Dim desWB As Workbook, desWS As Worksheet, srcWB As Workbook, val As String, fnd As Range
    Set desWB = ThisWorkbook
    Set desWS = desWB.Sheets("RESULT")
    With desWS.UsedRange
        .Offset(1).ClearContents
        .Borders.LineStyle = xlNone
    End With
    With desWB
        Application.DisplayAlerts = False
        For Each ws In .Sheets
            If ws.Name <> desWS.Name Then
                ws.Delete
            End If
        Next ws
        Application.DisplayAlerts = True
    End With
    Const strPath As String = "D:\ab\INVOICES\"
    strExtension = Dir(strPath & "INV*.xlsm")
    Set dic = CreateObject("Scripting.Dictionary")
    Do While strExtension <> ""
        If strExtension Like "INV*" Then
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Sheets("SH1").Copy before:=desWB.Sheets("RESULT")
            ActiveSheet.Name = Split(srcWB.Name, ".")(0)
            srcWB.Close savechanges:=False
            With ActiveSheet
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                v = .Range("C22:C" & lRow - 1).Resize(, 3).Value
                For i = LBound(v) To UBound(v)
                    val = v(i, 1) & "|" & v(i, 3)
                    If Not dic.exists(val) Then
                        dic.Add val, v(i, 2)
                        With desWS
                            .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Resize(, 3).Value = Array(v(i, 1), v(i, 2), v(i, 3))
                        End With
                    Else
                        With desWS
                            Set fnd = .Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                            .Range("C" & fnd.Row).Resize(, 3).Value = Array(v(i, 1), v(i, 2) + dic(val), v(i, 3))
                        End With
                    End If
                Next i
            End With
        End If
        strExtension = Dir
    Loop
    desWS.Activate
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("B22").Value = "1"
    Range("B22").AutoFill Destination:=Range("B22").Resize(lRow - 21), Type:=xlFillSeries
    Range("B" & lRow + 1) = "TOTAL"
    Range("F22:F" & lRow).Formula = "=D22*E22"
    Range("D" & lRow + 1).Formula = "=sum(D22:D" & lRow & ")"
    Range("F" & lRow + 1).Formula = "=sum(F22:F" & lRow & ")"
    Range("E22:F" & lRow + 1).NumberFormat = "#,##0.00"
    ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
    Application.ScreenUpdating = True
End Sub