Copying Data from 3 tabs into one Summary tab

[philb99]

Hi - I presently have 3 tabs with the same headings which represents three distinct regions in the business. The tab name is the only identifying feature and I have to add this when copying to the summary tab.

I now wish to set functionality so that all of the data feeds automatically into the Summary TAB (to save me selecting and then Copy + Pasting and ensuring I have added the Region name on after each action)

Can anyone help please?

 

[alansidman]

OK. Good Luck with getting your solution. I'm sure that someone else has the time to recreate your data for you.

 

[philb99]

Cannot manipulate data in a picture. Please update the data using XL2BB.

Hi Alan, with a little help I now have the addin for my v2013 although I cant actually see what to do next as nothing on my Ribbons - are you able to help please

 

[philb99]

OK. Good Luck with getting your solution. I'm sure that someone else has the time to recreate your data for you.

Can you help Alan

Test case regions.xlsx
	A	B	C	D	E	F	G
1	Product	Amount	Country export	Date	Brand	Rep	Customer
2	Apples	200	Spain	01/02/2021	Worcester	Tom	Bulmers
3	Pears	3256	France	01/06/2021	Surrey	Dave	Fiat
4	Cherries	10234	Usa	01/03/2021	Rose	Frank	Youngs
5	Peaches	5692	Canada	01/08/2021	Reds	Emma	Ingles
6	Oranges	3215	Holland	01/07/2021	Seville	Ann	Thompsons
South

Test case regions.xlsx
	A	B	C	D	E	F	G
1	Product	Amount	Country export	Date	Brand	Rep	Customer
2	Apples	200	Spain	01/02/2021	Worcester	Peter	Bulmers
3	Pears	3256	France	01/06/2021	Surrey	Alan	Fiat
4	Cherries	10234	Usa	01/03/2021	Rose	Francis	Youngs
5	Peaches	5692	Canada	01/08/2021	Reds	Jane	Ingles
6	Oranges	3215	Holland	01/07/2021	Seville	Anna	Thompsons
North

Test case regions.xlsx
	A	B	C	D	E	F	G
1	Product	Amount	Country export	Date	Brand	Rep	Customer
2	Apples	556	Spain	01/04/2021	Worcester	clive	Bulmers
3	Pears	8965	France	01/05/2021	Surrey	alex	Fiat
4	Cherries	14567	Usa	01/01/1900	Rose	john	Youngs
5	Peaches	87165	Canada	01/07/2021	Reds	phil	Ingles
6	Oranges	258	Holland	01/01/2021	Seville	jules	Thompsons
East

Test case regions.xlsx
	A	B	C	D	E	F	G	H
1	Product	Amount	Country export	Date	Brand	Rep	Customer	Region
2	Apples	200	Spain	01/02/2021	Worcester	Peter	Bulmers	North
3	Pears	3256	France	01/06/2021	Surrey	Alan	Fiat	North
4	Cherries	10234	Usa	01/03/2021	Rose	Francis	Youngs	North
5	Peaches	5692	Canada	01/08/2021	Reds	Jane	Ingles	North
6	Oranges	3215	Holland	01/07/2021	Seville	Anna	Thompsons	North
7	Apples	200	Spain	01/02/2021	Worcester	Tom	Bulmers	South
8	Pears	3256	France	01/06/2021	Surrey	Dave	Fiat	South
9	Cherries	10234	Usa	01/03/2021	Rose	Frank	Youngs	South
10	Peaches	5692	Canada	01/08/2021	Reds	Emma	Ingles	South
11	Oranges	3215	Holland	01/07/2021	Seville	Ann	Thompsons	South
12	Apples	556	Spain	01/04/2021	Worcester	clive	Bulmers	East
13	Pears	8965	France	01/05/2021	Surrey	alex	Fiat	East
14	Cherries	14567	Usa	01/01/1900	Rose	john	Youngs	East
15	Peaches	87165	Canada	01/07/2021	Reds	phil	Ingles	East
16	Oranges	258	Holland	01/01/2021	Seville	jules	Thompsons	East
Summary

 

[alansidman]

let
    Source = Excel.Workbook(File.Contents("C:\Users\alans\Downloads\PQ Append.xlsx"), null, true),
    #"Removed Other Columns" = Table.SelectColumns(Source,{"Name", "Data"}),
    #"Expanded Data" = Table.ExpandTableColumn(#"Removed Other Columns", "Data", {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6", "Column7"}, {"Data.Column1", "Data.Column2", "Data.Column3", "Data.Column4", "Data.Column5", "Data.Column6", "Data.Column7"}),
    #"Promoted Headers" = Table.PromoteHeaders(#"Expanded Data", [PromoteAllScalars=true]),
    #"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"South", type text}, {"Product", type text}, {"Amount", type any}, {"Country export", type text}, {"Date", type any}, {"Brand", type text}, {"Rep", type text}, {"Customer", type text}}),
    #"Filtered Rows" = Table.SelectRows(#"Changed Type", each ([Product] <> "Product"))
in
    #"Filtered Rows"

Book2
	A	B	C	D	E	F	G	H
1	South	Product	Amount	Country export	Date	Brand	Rep	Customer
2	South	Apples	200	Spain	44228	Worcester	Tom	Bulmers
3	South	Pears	3256	France	44348	Surrey	Dave	Fiat
4	South	Cherries	10234	Usa	44256	Rose	Frank	Youngs
5	South	Peaches	5692	Canada	44409	Reds	Emma	Ingles
6	South	Oranges	3215	Holland	44378	Seville	Ann	Thompsons
7	North	Apples	200	Spain	44228	Worcester	Peter	Bulmers
8	North	Pears	3256	France	44348	Surrey	Alan	Fiat
9	North	Cherries	10234	Usa	44256	Rose	Francis	Youngs
10	North	Peaches	5692	Canada	44409	Reds	Jane	Ingles
11	North	Oranges	3215	Holland	44378	Seville	Anna	Thompsons
12	East	Apples	556	Spain	44287	Worcester	clive	Bulmers
13	East	Pears	8965	France	44317	Surrey	alex	Fiat
14	East	Cherries	14567	Usa	1.2	Rose	john	Youngs
15	East	Peaches	87165	Canada	44378	Reds	phil	Ingles
16	East	Oranges	258	Holland	44197	Seville	jules	Thompsons
17
North

The key to getting the Sheet names is to not let PQ automatically append the three tabs. Remove the steps except the first one and then manually highlight the first two columns and remove the other columns. Then promote the headers. Remove the duplicate headers and you have your appended data.

 

[alansidman]

this is a better video for what you are doing

 

[philb99]

let
    Source = Excel.Workbook(File.Contents("C:\Users\alans\Downloads\PQ Append.xlsx"), null, true),
    #"Removed Other Columns" = Table.SelectColumns(Source,{"Name", "Data"}),
    #"Expanded Data" = Table.ExpandTableColumn(#"Removed Other Columns", "Data", {"Column1", "Column2", "Column3", "Column4", "Column5", "Column6", "Column7"}, {"Data.Column1", "Data.Column2", "Data.Column3", "Data.Column4", "Data.Column5", "Data.Column6", "Data.Column7"}),
    #"Promoted Headers" = Table.PromoteHeaders(#"Expanded Data", [PromoteAllScalars=true]),
    #"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"South", type text}, {"Product", type text}, {"Amount", type any}, {"Country export", type text}, {"Date", type any}, {"Brand", type text}, {"Rep", type text}, {"Customer", type text}}),
    #"Filtered Rows" = Table.SelectRows(#"Changed Type", each ([Product] <> "Product"))
in
    #"Filtered Rows"

Book2
	A	B	C	D	E	F	G	H
1	South	Product	Amount	Country export	Date	Brand	Rep	Customer
2	South	Apples	200	Spain	44228	Worcester	Tom	Bulmers
3	South	Pears	3256	France	44348	Surrey	Dave	Fiat
4	South	Cherries	10234	Usa	44256	Rose	Frank	Youngs
5	South	Peaches	5692	Canada	44409	Reds	Emma	Ingles
6	South	Oranges	3215	Holland	44378	Seville	Ann	Thompsons
7	North	Apples	200	Spain	44228	Worcester	Peter	Bulmers
8	North	Pears	3256	France	44348	Surrey	Alan	Fiat
9	North	Cherries	10234	Usa	44256	Rose	Francis	Youngs
10	North	Peaches	5692	Canada	44409	Reds	Jane	Ingles
11	North	Oranges	3215	Holland	44378	Seville	Anna	Thompsons
12	East	Apples	556	Spain	44287	Worcester	clive	Bulmers
13	East	Pears	8965	France	44317	Surrey	alex	Fiat
14	East	Cherries	14567	Usa	1.2	Rose	john	Youngs
15	East	Peaches	87165	Canada	44378	Reds	phil	Ingles
16	East	Oranges	258	Holland	44197	Seville	jules	Thompsons
17
North

The key to getting the Sheet names is to not let PQ automatically append the three tabs. Remove the steps except the first one and then manually highlight the first two columns and remove the other columns. Then promote the headers. Remove the duplicate headers and you have your appended data.

Appreciate your help Alan but as I am trying to complete this within the works IT framework they do not have the ability to download Power Query add-in - Is there another way?

 

[alansidman]

Option Explicit

Sub Append()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, lr As Long, lrM As Long, s As Worksheet
    Set s = Worksheets("Master")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            ws.Range("A1").EntireColumn.Insert
            ws.Range("A1") = "Region"
            lr = ws.Range("B" & Rows.Count).End(xlUp).Row
            ws.Range("A2:A" & lr) = ws.Name
            ws.Range("A1").CurrentRegion.Copy
            lrM = s.Range("A" & Rows.Count).End(xlUp).Row
            s.Range("A" & lrM + 1).PasteSpecial xlPasteValues
        End If
    Next ws
    Dim i As Long
    lrM = s.Range("A" & Rows.Count).End(xlUp).Row
        For i = lrM To 3 Step -1
            If s.Range("A" & i) = "Region" Then
            s.Range("A" & i).EntireRow.Delete
            End If
         Next i
         
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Completed"

End Sub

 

[philb99]

Option Explicit

Sub Append()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, lr As Long, lrM As Long, s As Worksheet
    Set s = Worksheets("Master")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            ws.Range("A1").EntireColumn.Insert
            ws.Range("A1") = "Region"
            lr = ws.Range("B" & Rows.Count).End(xlUp).Row
            ws.Range("A2:A" & lr) = ws.Name
            ws.Range("A1").CurrentRegion.Copy
            lrM = s.Range("A" & Rows.Count).End(xlUp).Row
            s.Range("A" & lrM + 1).PasteSpecial xlPasteValues
        End If
    Next ws
    Dim i As Long
    lrM = s.Range("A" & Rows.Count).End(xlUp).Row
        For i = lrM To 3 Step -1
            If s.Range("A" & i) = "Region" Then
            s.Range("A" & i).EntireRow.Delete
            End If
         Next i
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Completed"

End Sub

Thank you Alan for your support, works perfectly.

 

[Fluff]

@philb99 in future please mark the post that helped you the most as the solution, rather than your post saying it works.
I have done it for you this time. Thanks

 

[philb99]

@philb99 in future please mark the post that helped you the most as the solution, rather than your post saying it works.
I have done it for you this time. Thanks

Noted - its been a while since I have been on the forum and this is the first time that I read about this functionality.