VBA code to consolidate data tabs

[Matrix007]

Hello
I need a VBA code to consolidate data from numerous tabs into one. The format of the data tabs remain the same.
See the attached example where sales from different departments need to be copied across to the consolidated tab.
Thanking you in advance for your help.

https://photos.google.com/share/AF1...?key=UWpoR195WHBVRkRnUWFSVDkyZVNMYWREQmhNOC1n

 

[My Aswer Is This]

We need specific details. Assume all I know is what you tell me.
I never open links.

We need things like sheet names and column numbers.

 

[Matrix007]

I have 5 tabs

TAB1: "ConsolidatedData" this is where the data needs to be consolidated. I will receive data from various departments in the tab2 to tab5 format. At present I am manually copy pasting. I want to automate this

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Pen	20	$ 10.00	$ 200.00	Dept1
3	Pencil	15	$ 5.00	$ 75.00	Dept1
4	Rubber	50	$ 2.00	$ 100.00	Dept2
5	Note Pad	12	$ 8.00	$ 96.00	Dept3
6	Ink pen	4	$ 15.00	$ 60.00	Dept4
7	Ruller	6	$ 5.00	$ 30.00	Dept4

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

TAB2: "Dept1"

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Pen	20	$ 10.00	$ 200.00	Dept1
3	Pencil	15	$ 5.00	$ 75.00	Dept1
4
5
6
7

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

TAB3: "Dept2"

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Rubber	50	$ 2.00	$ 100.00	Dept2
3
4
5
6
7

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

TAB4: "Dept3"

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Note Pad	12	$ 8.00	$ 96.00	Dept3
3
4
5
6
7

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

TAB5: "Dept4"

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Ink pen	4	$ 15.00	$ 60.00	Dept4
3	Ruller	6	$ 5.00	$ 30.00	Dept4
4
5
6
7

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[Trebor76]

Hi Matrix007,

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim lngCounter As Long
    Dim wsMySheet As Worksheet
    
    Application.ScreenUpdating = False
    
    'Clear any existing consolidated data
    lngLastRow = Sheets("ConsolidatedData").Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lngLastRow >= 2 Then
        Sheets("ConsolidatedData").Range("A2:E" & lngLastRow).ClearContents
    End If
    
    For Each wsMySheet In ThisWorkbook.Sheets
        If wsMySheet.Name <> "ConsolidatedData" Then
            lngCounter = lngCounter + 1
            lngLastRow = wsMySheet.Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lngCounter = 1 Then
                wsMySheet.Range("A2:E" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("A2")
            Else
                lngPasteRow = Sheets("ConsolidatedData").Range("A:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                wsMySheet.Range("A2:E" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("A" & lngPasteRow)
            End If
        End If
    Next wsMySheet
    
    Application.ScreenUpdating = True
    
End Sub

Robert

 

[Matrix007]

Thank you Robert, works well.
Awesome!

 

[Trebor76]

Thanks for the feedback and you're welcome

Thanks also for the thanks and like

 

[Matrix007]

Hi

Is there a way that the tab names "Dept1", "Dept2", "Dept3", "Dept4" etc....can be auto populated in the "ConsolidatedData" in col F?
I have just noticed that the data that I am receiving does not always have the Col F populated, hence it would be great if the tab names can be can be auto populated in the "ConsolidatedData" in col F.

Revised example below with no Col F data in the data tabs but the tab names becomes the col F of the "consolidated tab"

TAB1: "ConsolidatedData" this is where the data needs to be consolidated. I will receive data from various departments in the tab2 to tab5 format. At present I am manually copy pasting. I want to automate this

	A	B	C	E	F
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount	Dept
2	Pen	20	$10.00	$200.00	Dept1
3	Pencil	15	$5.00	$75.00	Dept1
4	Rubber	50	$2.00	$100.00	Dept2
5	Note Pad	12	$8.00	$96.00	Dept3
6	Ink pen	4	$15.00	$60.00	Dept4
7	Ruller	6	$5.00	$30.00	Dept4
TAB2: "Dept1"
	A	B	C	E
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount
2	Pen	20	$10.00	$200.00
3	Pencil	15	$5.00	$75.00
4
5
6
7
TAB3: "Dept2"
	A	B	C	E
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount
2	Rubber	50	$2.00	$100.00
3
4
5
6
7
TAB4: "Dept3"
	A	B	C	E
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount
2	Note Pad	12	$8.00	$96.00
3
4
5
6
7
TAB5: "Dept4"
	A	B	C	E
1	Product Name	Unit Sales	Pric Per Unit	Sales Amount
2	Ink pen	4	$15.00	$60.00
3	Ruller	6	$5.00	$30.00
4
5
6
7

<colgroup><col span="6"></colgroup><tbody>
</tbody>

<tbody>
</tbody>

 

[Make it work]

Hey, this works great. I have something similar im working on and my questions is,i have example 5 tabs with different names (the tab names keep changing). I want the name of that tab to appear in the consolidated tab as cell A2,A3 etc... any suggestions?

 

[Trebor76]

Is there a way that the tab names "Dept1", "Dept2", "Dept3", "Dept4" etc....can be auto populated in the "ConsolidatedData" in col F?

I have just changed the range references from originally code from E to F in the following which should do the job:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim lngCounter As Long
    Dim wsMySheet As Worksheet
    
    Application.ScreenUpdating = False
    
    'Clear any existing consolidated data
    lngLastRow = Sheets("ConsolidatedData").Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lngLastRow >= 2 Then
        Sheets("ConsolidatedData").Range("A2:F" & lngLastRow).ClearContents
    End If
    
    For Each wsMySheet In ThisWorkbook.Sheets
        If wsMySheet.Name <> "ConsolidatedData" Then
            lngCounter = lngCounter + 1
            lngLastRow = wsMySheet.Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lngCounter = 1 Then
                wsMySheet.Range("A2:F" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("A2")
            Else
                lngPasteRow = Sheets("ConsolidatedData").Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                wsMySheet.Range("A2:F" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("A" & lngPasteRow)
            End If
        End If
    Next wsMySheet
    
    Application.ScreenUpdating = True
    
End Sub

 

[Trebor76]

Hi Make it work,

Welcome to MrExcel!!

Though ideally you start a new thread for your own requirement, this should do what you need:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim lngCounter As Long
    Dim wsMySheet As Worksheet
    
    Application.ScreenUpdating = False
    
    'Clear any existing consolidated data
    lngLastRow = Sheets("ConsolidatedData").Range("A:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lngLastRow >= 2 Then
        Sheets("ConsolidatedData").Range("A2:G" & lngLastRow).ClearContents
    End If
    
    For Each wsMySheet In ThisWorkbook.Sheets
        If wsMySheet.Name <> "ConsolidatedData" Then
            lngCounter = lngCounter + 1
            lngLastRow = wsMySheet.Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lngCounter = 1 Then
                wsMySheet.Range("A2:F" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("B2")
                lngLastRow = Sheets("ConsolidatedData").Range("B:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                Sheets("ConsolidatedData").Range("A2:A" & lngLastRow).Value = wsMySheet.Name
            Else
                lngPasteRow = Sheets("ConsolidatedData").Range("A:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                wsMySheet.Range("A2:F" & lngLastRow).Copy Destination:=Sheets("ConsolidatedData").Range("B" & lngPasteRow)
                lngLastRow = Sheets("ConsolidatedData").Range("B:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                Sheets("ConsolidatedData").Range("A" & lngPasteRow & ":A" & lngLastRow).Value = wsMySheet.Name
            End If
        End If
    Next wsMySheet
    
    Application.ScreenUpdating = True
    
End Sub

It will consolidate the data from columns A to F the tabs into the ConsolidatedData tab into columns B to G. Column A will used for the tab name that has had its data copied.

Hope this helps,

Robert

Regards,

Robert