VB to copy rows under different headers from multiple sheets to a master sheet.

[aryansaran2008]

hi,
I need help in copying data from multiple sheets into one master sheet but the problem is that the data in one sheet is further divided into 4 sections.

Details:
I have a workbook having 2 sheets
1) May Forecast-Rel Team
2)May Forecasr-RR team


Each of these sheets has 4 sections and each section has employees under it.

There is a 4th master sheet "May Forecast" that consolidates data from these 2 sheets.
This has again same 4 sections as above.

I want to write a macro that copies the employee data under each header and copy to master sheet under the same header.

Note: A new employee can be added and deleted and the final sheet should reflect that too.
Need to copy the format too!

example:
Sheet1 : May Forecast-Rel Team

2015 022838 Forecast with I&O Costs
name	amount
a	10
2015 External Forecast
name	amount
b	20
2015 ADMIN Forecast
name	amount
c	30
2015 022838 Forecast without I&O
name	amount
d	40

<tbody>
</tbody>

example:
Sheet2 : May Forecasr-RR team

2015 022838 Forecast with I&O Costs
name	amount
b	40
2015 External Forecast
name	amount
b	30
2015 ADMIN Forecast
name	amount
c	20
2015 022838 Forecast without I&O
name	amount
d	10

<tbody>
</tbody>

Final result sheet May Forecast:

2015 022838 Forecast with I&O Costs
name	amount
a	10
b	40
2015 External Forecast
name	amount
a	20
b	30
2015 ADMIN Forecast
name	amount
a	30
b	20
2015 022838 Forecast without I&O
name	amount
a	40
b	10

<tbody>
</tbody>

 

[DocAElstein]

. Hi aryansaran
. Welcome to the board.
. You explained your requirement quite well and the tables were reasonably clear.
. However, Correct me if I am wrong, But I believe you may have got your names a bit muddled in your final result sheet ( May Forecast ) ?
. Also this infers 4 sheets, rather than the 3 you have indicated??

......
I need help in copying data from multiple sheets into one master sheet but the problem is that the data in one sheet is further divided into 4 sections.

Details:
I have a workbook having 2 sheets
1) May Forecast-Rel Team
2)May Forecasr-RR team


Each of these sheets has 4 sections and each section has employees under it.

There is a 4th master sheet "May Forecast" that consolidates data from these 2 sheets........

……..
. I have written the code then anyway to include an extra sheet which you do nothing with ( Called aptly "SheetToIgnoor" ! )

…………


. Anyway, this requirement is less of a technical challenge, just a case of very carefully looping and comparing for appropriate matches and then copying ( Inserting ) the info into the correct place in the Summary sheet.
. As format must be preserved I have done the simpler, but usually less efficient “Spreadsheet Interaction” type approach.
.
. I assume the input data is of the type you gave ( And that your headings always start with “2015” )

Input data:

Using Excel 2007

-	A​	B​
1​	2015 022838 Forecast with I&O Costs
2​	name	amount
3​	a	10
4​
5​	2015 External Forecast
6​	name	amount
7​	b	20
8​	2015 ADMIN Forecast
9​	name	amount
10​	c	30
11​	2015 022838 Forecast without I&O
12​	name	amount
13​	d	40

May Forecast-Rel Team

. and:

Using Excel 2007

-	A​	B​
1​	2015 022838 Forecast with I&O Costs
2​	name	amount
3​	b	40
4​
5​	2015 External Forecast
6​	name	amount
7​	b	30
8​	2015 ADMIN Forecast
9​	name	amount
10​	c	20
11​	2015 022838 Forecast without I&O
12​	name	amount
13​	d	10
14​

May Forecasr-RR team

. After running the code I give you at the end you achieve This:

Using Excel 2007

-	A​	B​
1​	2015 022838 Forecast with I&O Costs
2​	name	amount
3​	a	10
4​	b	40
5​	2015 External Forecast
6​	name	amount
7​	b	20
8​	b	30
9​	2015 ADMIN Forecast
10​	name	amount
11​	c	30
12​	c	20
13​	2015 022838 Forecast without I&O
14​	name	amount
15​	d	40
16​	d	10

May Forecast

Or this:

Using Excel 2007

-	A​	B​
1​	2015 022838 Forecast with I&O Costs
2​	name	amount
3​	a	10
4​
5​	b	40
6​
7​	2015 External Forecast
8​	name	amount
9​	b	20
10​	b	30
11​	2015 ADMIN Forecast
12​	name	amount
13​	c	30
14​	c	20
15​	2015 022838 Forecast without I&O
16​	name	amount
17​	d	40
18​	d	10

May Forecast

. Which you receive is based on which of these two code lines you choose to use

                        [color=blue]If[/color] Left(ws.Cells(r2, 1).Value, 4) <> "2015" [color=blue]Then[/color]  [color=lightgreen]'Condition met for name[/color]
                        [color=lightgreen]'If ws.Cells(r2, 1).Value <> "" And Left(ws.Cells(r2, 1).Value, 4) <> "2015" Then 'This alternative line to above line would not include empty cells[/color]

. I suggest you go carefully through the ’Green Comments that I have written to understand the code in case you need to modify it for your actual data. The code in its present form is fairly flexible, but without more details and / or more data to cover all possible scenarios I have “guessed” or “assumed a few things along the way . – which is probably not a good Profi approach .. ( But I am still learning by attempting to answer these sort of Threads..!!)


. here the code:

[color=blue]Option[/color] [color=blue]Explicit[/color]
[color=blue]Sub[/color] aryansaran2008SimpleSort()
[color=lightgreen]'.1) Some initial Workbook info: Summary sheet name and number of sheets[/color]
[color=blue]Dim[/color] wsSummary [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsSummary = ThisWorkbook.Worksheets("May Forecast") [color=lightgreen]'Abbreviation gets methods, Properties of worksheets object through .dot[/color]
[color=blue]Dim[/color] wsCnt [color=blue]As[/color] [color=blue]Long[/color], Cnt [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'variables for number of worksheeets. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.[/color]
[color=blue]Let[/color] wsCnt = ThisWorkbook.Worksheets.Count [color=lightgreen]'Obtain number of worksheets inn this workbook[/color]
 
[color=lightgreen]'.2) Clear Summary sheet and Put all headings in[/color]
wsSummary.UsedRange.ClearContents [color=lightgreen]'Will clear anything on summary sheet ( Any ranges that were used )[/color]
wsSummary.Range("A1").Resize(1, 2) = Array("2015 022838 Forecast with I&O Costs", "")
wsSummary.Range("A2").Resize(1, 2) = Array("name", "amount")
wsSummary.Range("A3").Resize(1, 2) = Array("2015 External Forecast", "")
wsSummary.Range("A4").Resize(1, 2) = Array("name", "amount")
wsSummary.Range("A5").Resize(1, 2) = Array("2015 ADMIN Forecast", "")
wsSummary.Range("A6").Resize(1, 2) = Array("name", "amount")
wsSummary.Range("A7").Resize(1, 2) = Array("2015 022838 Forecast without I&O", "")
wsSummary.Range("A8").Resize(1, 2) = Array("name", "amount")
 
[color=lightgreen]'.3) Main loopings for bringing info from shhets to Summary Sheet[/color]
[color=blue]Dim[/color] r [color=blue]As[/color] [color=blue]Long[/color], r2 [color=blue]As[/color] [color=blue]Long[/color], rInsert [color=blue]As[/color] [color=blue]Long[/color], rHd [color=blue]As[/color] [color=blue]Long[/color], lr [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'variable for rows in sheets, and last Row of sheet. Assume our File for Input has a reasonably well defined end.[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=lightgreen]'Worksheet being looked at in loop below[/color]
[color=blue]Dim[/color] namemax [color=blue]As[/color] Long: [color=blue]Let[/color] namemax = 5 [color=lightgreen]'Maximum likely number of names in any heading[/color]
    [color=lightgreen]'.3a) Loop for each sheet[/color]
    [color=blue]For[/color] Cnt = wsCnt [color=blue]To[/color] 1 [color=blue]Step[/color] -1  [color=lightgreen]'Take ( Loop) each worksheet in turn ( Working "backwards" is simply done to get the name order required )[/color]
        [color=blue]Set[/color] ws = ThisWorkbook.Worksheets.Item(Cnt)
        [color=blue]If[/color] ws.Name <> wsSummary.Name And ws.Name <> "SheetToIgnoor" [color=blue]Then[/color] [color=lightgreen]'Disclude any sheets to be discluded[/color]
            [color=lightgreen]'.3b)Outer Loop of rows within each sheet[/color]
        [color=blue]Let[/color] lr = ws.Cells(Rows.Count, 1).End(xlUp).Row [color=lightgreen]'The last cell in column 1 has the .End property( Argument "gooing upwards" applied returning a new range (cell) from which the .Row Property returs the last row.[/color]
            [color=blue]For[/color] r = 1 [color=blue]To[/color] lr [color=blue]Step[/color] 1 [color=lightgreen]'Main loop for each sheet, going down rows[/color]
                [color=blue]If[/color] Left(ws.Cells(r, 1).Value, 4) = "2015" [color=blue]Then[/color] [color=lightgreen]' we hit a header, so[/color]
                    [color=lightgreen]'.3c) Nested inner loop for case more than one name....[/color]
                    [color=blue]For[/color] r2 = r + 2 [color=blue]To[/color] r + 2 + namemax - 2 [color=lightgreen]'..... - Go down names after heading[/color]
                        [color=blue]If[/color] Left(ws.Cells(r2, 1).Value, 4) <> "2015" [color=blue]Then[/color]  [color=lightgreen]'Condition met for name[/color]
                        [color=lightgreen]'If ws.Cells(r2, 1).Value <> "" And Left(ws.Cells(r2, 1).Value, 4) <> "2015" Then 'This alternative line to above line would not include empty cells[/color]
                        [color=blue]Let[/color] rInsert = rInsert + 1 [color=lightgreen]'Increment for insert row based on number of names in nested loop[/color]
                        [color=blue]Let[/color] rHd = wsSummary.Cells.Find(What:=ws.Cells(r, 1).Value, After:=wsSummary.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row [color=lightgreen]'Determine Row in Summary sheet with current heading being investigated in current sheet. Method: You start at first cell then go forwards (which effectively starts at end of sheet), sercching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method here for fun- finds last row in sheet rather than row for last entry in particular cell[/color]
                        ws.Rows(r2).Copy [color=lightgreen]'Copy appropriate line in current sheet being looked at and...[/color]
                        wsSummary.Rows(rHd + 2 + rInsert - 1).Insert Shift:=xlDown
                        [color=blue]If[/color] r = lr - 2 [color=blue]Then[/color] [color=blue]Exit[/color] [color=blue]For[/color] [color=lightgreen]'This line prevents copying empty lines after the last line in the current sheet[/color]
                        [color=blue]Else[/color] [color=lightgreen]'we have  A heading (Or empty cell ) so[/color]
                        [color=blue]Exit[/color] [color=blue]For[/color] [color=lightgreen]'exit this nested loop and go back to main loop in each sheet[/color]
                        [color=blue]End[/color] [color=blue]If[/color]
 
                    [color=blue]Next[/color] r2 [color=lightgreen]'Go and check for another name under current heading[/color]
                    [color=blue]Let[/color] rInsert = 0 [color=lightgreen]'reset the row for number of names within nested loop[/color]
                [color=blue]Else[/color] [color=lightgreen]'No header, no action, redundant code[/color]
                [color=blue]End[/color] [color=blue]If[/color]
            [color=blue]Next[/color] r [color=lightgreen]'Go to next row in current sheet being looked at[/color]
        [color=blue]Else[/color] [color=lightgreen]'Do nothing. Redundant code[/color]
        [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] Cnt [color=lightgreen]'go to next worksheet[/color]
Application.CutCopyMode = [color=blue]False[/color] [color=lightgreen]'Stops screen selection flicker after Pasting[/color]
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'aryansaran2008SimpleSort()[/color]

. let me know please how you get on.
Alan


P.s. There is probably a more efficient Profi way to do this. If anyone has one to offer, as always I would be very interested and it would as always make for a very good Thread showing different solution possibilities. ( Important point here for anyone offering another solution is that Format is to be preserved, which is one reason i did not employ a more efficient “VBA Array” type approach. )

 

[DocAElstein]

. Hi ( again!!! ) aryansaran

. I had already struggled with and answered your shortened with missing info version of this post here before I stumbled on the unanswered more detailed Duplicate of this Thread here:
VB to copy rows under different headers from multiple sheets to a master sheet.

. As I had already done part of the code necessary for this complete version of your requirement I decided to continue. As this is your first time here and at ExcelForum, you can maybe be forgiven for duplicate posting. But there are rules about it. ( I expect a Moderator will come in and tell you about them. ) . This is a classic example of why you should take note of those rules. I have wasted a considerable amount of time and made the code unnecessarily detailed due to the differing info you have given in the two Threads.

Here is my final Code version which comes closer , if not exactly meets, your actual requirements…:

[color=blue]Option[/color] [color=blue]Explicit[/color]
[color=blue]Sub[/color] aryansaran2008SimpleSortExcelForum()
[color=darkgreen]'.1) Some initial Workbook info: Summary sheet name and number of sheets[/color]
[color=blue]Dim[/color] wsSummary [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsSummary = ThisWorkbook.Worksheets("May Forecast") [color=darkgreen]'Abbreviation gets methods, Properties of worksheets object through .dot[/color]
[color=blue]Dim[/color] wsCnt [color=blue]As[/color] [color=blue]Long[/color], Cnt [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]'variables for number of worksheeets. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.[/color]
[color=blue]Let[/color] wsCnt = ThisWorkbook.Worksheets.Count [color=darkgreen]'Obtain number of worksheets inn this workbook[/color]
 
[color=darkgreen]'.2) Clear Summary sheet and Put all headings in, assume arbritrarily thet second sheet has all headings in it[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet [color=darkgreen]'Worksheet being looked at here and all those in loop .3a) in .3) below[/color]
[color=blue]Dim[/color] r [color=blue]As[/color] [color=blue]Long[/color], lr [color=blue]As[/color] [color=blue]Long[/color], rs [color=blue]As[/color] Long: [color=blue]Let[/color] rs = -1 [color=darkgreen]'rows in sheets, last row in sheet, rows in summary sheet[/color]
wsSummary.UsedRange.Clear [color=darkgreen]'Will clear anything on summary sheet ( Any ranges that were used )[/color]
[color=blue]Set[/color] ws = ThisWorkbook.Worksheets.Item(2) [color=darkgreen]'Second sheet placed in worksheet chosen arbritrarily. Must have all headers in[/color]
[color=blue]Let[/color] lr = ws.Cells(Rows.Count, 1).End(xlUp).Row [color=darkgreen]'The last cell in column 1 has the .End property( Argument "gooing upwards" applied returning a new range (cell) from which the .Row Property returs the last row.[/color]
    [color=blue]For[/color] r = 1 [color=blue]To[/color] lr [color=blue]Step[/color] 1 [color=darkgreen]'Look down rows in sheet and..[/color]
        [color=blue]If[/color] Left(ws.Cells(r, 1).Value, 4) = "2015" [color=blue]Then[/color] [color=darkgreen]' look to see if we hit a heading.. and if so[/color]
        [color=blue]Let[/color] rs = rs + 2 [color=darkgreen]'Increase row in summary sheet to next available row and..[/color]
        ws.Rows("" & r & ":" & r + 1 & "").Copy [color=darkgreen]'.. copy Heading and next row[/color]
        wsSummary.Rows("" & rs & ":" & rs + 1 & "").PasteSpecial Paste:=xlPasteAllUsingSourceTheme [color=darkgreen]'Being very Explicit here with an extra line enabling us to Paste Special with arguments to make sure the correct version from Clipboard is copied[/color]
        [color=blue]Else[/color] [color=darkgreen]'No heading, no action, redundant code[/color]
        [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] r
 
 
[color=darkgreen]'.3) Main loopings for bringing info from shhets to Summary Sheet[/color]
[color=blue]Dim[/color] r2 [color=blue]As[/color] [color=blue]Long[/color], rInsert [color=blue]As[/color] [color=blue]Long[/color], rHd [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]'variable for rows in sheets. Assume our File for Input has a reasonably well defined end.[/color]
[color=blue]Dim[/color] namemax [color=blue]As[/color] Long: [color=blue]Let[/color] namemax = 5 [color=darkgreen]'Maximum likely number of names in any heading[/color]
    [color=darkgreen]'.3a) Loop for each sheet[/color]
    [color=blue]For[/color] Cnt = wsCnt [color=blue]To[/color] 1 [color=blue]Step[/color] -1  [color=darkgreen]'Take ( Loop) each worksheet in turn ( Working "backwards" is simply done to get the name order required )[/color]
        [color=blue]Set[/color] ws = ThisWorkbook.Worksheets.Item(Cnt)
        [color=blue]If[/color] ws.Name <> wsSummary.Name And ws.Name <> "SheetToIgnoor" [color=blue]Then[/color] [color=darkgreen]'Disclude any sheets to be discluded[/color]
            [color=darkgreen]'.3b)Outer Loop of rows within each sheet[/color]
        [color=blue]Let[/color] lr = ws.Cells(Rows.Count, 1).End(xlUp).Row [color=darkgreen]'The last cell in column 1 has the .End property( Argument "gooing upwards" applied returning a new range (cell) from which the .Row Property returs the last row.[/color]
            [color=blue]For[/color] r = 1 [color=blue]To[/color] lr [color=blue]Step[/color] 1 [color=darkgreen]'Main loop for each sheet, going down rows[/color]
                [color=blue]If[/color] Left(ws.Cells(r, 1).Value, 4) = "2015" [color=blue]Then[/color] [color=darkgreen]' we hit a header, so[/color]
                    [color=darkgreen]'.3c) Nested inner loop for case more than one name....[/color]
                    [color=blue]For[/color] r2 = r + 2 [color=blue]To[/color] r + 2 + namemax - 2 [color=darkgreen]'..... - Go down names after heading[/color]
                        [color=darkgreen]'If Left(ws.Cells(r2, 1).Value, 4) <> "2015" Then  'Condition met for name[/color]
                        [color=blue]If[/color] ws.Cells(r2, 1).Value <> "" And Left(ws.Cells(r2, 1).Value, 4) <> "2015" [color=blue]Then[/color] [color=darkgreen]'This alternative line to above line would not include empty cells[/color]
                        [color=blue]Let[/color] rInsert = rInsert + 1 [color=darkgreen]'Increment for insert row based on number of names in nested loop[/color]
                        [color=blue]Let[/color] rHd = wsSummary.Cells.Find(What:=ws.Cells(r, 1).Value, After:=wsSummary.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row [color=darkgreen]'Determine Row in Summary sheet with current heading being investigated in current sheet. Method: You start at first cell then go forwards (which effectively starts at end of sheet), sercching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method here for fun- finds last row in sheet rather than row for last entry in particular cell[/color]
                        ws.Rows(r2).Copy [color=darkgreen]'Copy appropriate line in current sheet being looked at and...[/color]
                        ws.Rows(r2).PasteSpecial Paste:=xlValues [color=darkgreen]'These two lines...[/color]
                        ws.Rows(r2).Copy [color=darkgreen]'needed to get values rather than formulas copied[/color]
                        wsSummary.Rows(rHd + 2 + rInsert - 1).Insert Shift:=xlDown
                        [color=blue]If[/color] r = lr - 2 [color=blue]Then[/color] [color=blue]Exit[/color] [color=blue]For[/color] [color=darkgreen]'This line prevents copying empty lines after the last line in the current sheet[/color]
                        [color=blue]Else[/color] [color=darkgreen]'we have  A heading (Or empty cell ) so[/color]
                        [color=blue]Exit[/color] [color=blue]For[/color] [color=darkgreen]'exit this nested loop and go back to main loop in each sheet[/color]
                        [color=blue]End[/color] [color=blue]If[/color]
                    [color=blue]Next[/color] r2 [color=darkgreen]'Go and check for another name under current heading[/color]
                    [color=blue]Let[/color] rInsert = 0 [color=darkgreen]'reset the row for number of names within nested loop[/color]
                [color=blue]Else[/color] [color=darkgreen]'No header, no action, redundant code[/color]
                [color=blue]End[/color] [color=blue]If[/color]
            [color=blue]Next[/color] r [color=darkgreen]'Go to next row in current sheet being looked at[/color]
        [color=blue]Else[/color] [color=darkgreen]'Do nothing. Redundant code[/color]
        [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] Cnt [color=darkgreen]'go to next worksheet[/color]
Application.CutCopyMode = [color=blue]False[/color] [color=darkgreen]'Stops screen selection flicker after Pasting[/color]
[color=blue]End[/color] [color=blue]Sub[/color] [color=darkgreen]'aryansaran2008SimpleSortExcelForum()[/color]

. Please let me know in Both Threads how you get on with my solutions.

Alan Elston

 

[Joe4]

If you are going to Cross-post, please follow our rules for that outlined in rule #10 here: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html