Consolidating Lists from Other Worksheets in a Workbook to the same sheet.

Jay3

Board Regular
Joined
Jul 3, 2009
Messages
235
Hi,

I had an old workbook which consolidated team tasks into one sheet. I am trying to tweak it for another workbook I am building. Here's the original code I had.

VBA Code:
Option Explicit

Public Sub ConsolidateTasks()

  Dim ws As Worksheet
  Dim cws As Worksheet
 
  Dim iConsolRow As Long
  Dim iLastRow As Long
  Dim iTaskRow As Long
 
  Set cws = ThisWorkbook.Sheets("Task View by Date")
  iLastRow = cws.Cells(cws.Rows.Count, "B").End(xlUp).Row + 1
  cws.Range("B7:J" & iLastRow).ClearContents
 
  iConsolRow = 5
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> cws.Name Then
      iLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
      For iTaskRow = 6 To iLastRow
        iConsolRow = iConsolRow + 1
        ws.Cells(iTaskRow, "B").Resize(1, 4).Copy Destination:=cws.Cells(iConsolRow, "B")
        cws.Rows(iConsolRow).RowHeight = cws.Rows(6).RowHeight
      Next iTaskRow
    End If
  Next ws
 
  With cws.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("E6:E" & iConsolRow), SortOn:=xlSortOnValues, _
          Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("B6:E" & iConsolRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
 
  MsgBox "Done: " & CStr(iConsolRow - 5) & " entries copied to team worksheet" & Space(10), _
         vbOKOnly + vbInformation, "Team Deliverables"

End Sub

The problem is on the original workbook I had the consolidated sheet and the team sheets (the number of team sheets didn't change) so when consolidating the team sheets the macro ignored the consolidated sheet (cws) when copying the tasks. In my new workbook, I have other worksheets I need to ignore (which don't contain tasks) and also the number of worksheets containing individuals tasks can grow each time a new project is added.

So in summary when copying and pasting tasks to the consolidated tab it needs to ignore a predefined set of worksheets and then just keep going through all of the other worksheets however many there might be.

Any help with this would be much appreciated.

Thanks
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
How about
Rich (BB code):
  For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
      Case "Task View by Date", "Sheet1", "sheet2, "Sheet3"
      Case Else
         iLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
         For iTaskRow = 6 To iLastRow
           iConsolRow = iConsolRow + 1
           ws.Cells(iTaskRow, "B").Resize(1, 4).Copy Destination:=cws.Cells(iConsolRow, "B")
           cws.Rows(iConsolRow).RowHeight = cws.Rows(6).RowHeight
         Next iTaskRow
    End Select
  Next ws
Just change the names in blue to suit
 

Jay3

Board Regular
Joined
Jul 3, 2009
Messages
235
That looks a lot more straight forward, thanks. WIll see if I can get it to work.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Jay3

Board Regular
Joined
Jul 3, 2009
Messages
235

ADVERTISEMENT

Worked a charm :)
 

Jay3

Board Regular
Joined
Jul 3, 2009
Messages
235

ADVERTISEMENT

One last thing that I need to include, this is my code atm.

VBA Code:
Option Explicit

Public Sub ConsolidateTasks()

  Dim ws As Worksheet
  Dim cws As Worksheet
 
  Dim iConsolRow As Long
  Dim iLastRow As Long
  Dim iTaskRow As Long
 
  Set cws = ThisWorkbook.Sheets("Task View by Date")
  iLastRow = cws.Cells(cws.Rows.Count, "B").End(xlUp).Row + 1
  cws.Range("B7:J" & iLastRow).ClearContents
 
  iConsolRow = 7
 
   For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
      Case "New Project Requiring Board", "Task View by Date", "Project Board Template", "Lookups"
      Case Else
         iLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
         For iTaskRow = 7 To iLastRow
           iConsolRow = iConsolRow + 1
           ws.Cells(iTaskRow, "B").Resize(1, 9).Copy Destination:=cws.Cells(iConsolRow, "B")
           cws.Rows(iConsolRow).RowHeight = cws.Rows(6).RowHeight
         Next iTaskRow
    End Select
  Next ws
 
 
  With cws.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("H7:H" & iConsolRow), SortOn:=xlSortOnValues, _
          Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("B7:J" & iConsolRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
 
  MsgBox "Done: " & CStr(iConsolRow - 5) & " entries copied to team worksheet" & Space(10), _
         vbOKOnly + vbInformation, "Team Deliverables"

End Sub

What I need to incorporate is a filter so that any tasks that have a completed status of "Yes" in column M of their respective sheets are ignored? How can I do this?

Thanks :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
         For iTaskRow = 7 To iLastRow
           iConsolRow = iConsolRow + 1
           If Ws.Cells(iTaskRow, "M") <> "Yes" Then
               Ws.Cells(iTaskRow, "B").Resize(1, 9).Copy Destination:=cws.Cells(iConsolRow, "B")
               cws.Rows(iConsolRow).RowHeight = cws.Rows(6).RowHeight
           End If
         Next iTaskRow
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
My pleasure
 

Watch MrExcel Video

Forum statistics

Threads
1,127,755
Messages
5,626,671
Members
416,200
Latest member
Pulsar3000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top