VBA – copy rows of data from specified worksheets

[Richard JIBS]

Hello,

I have a workbook that contains logistics plans for several events. Each event has its own worksheet.

I would like all data from selected event logistics plan copied into an ALL DATA worksheet.

The workbook is structured as follows with these worksheets:

ACTIVE EVENTS (contains a list of event codes, which are also the names of the worksheets for each of the events. The number of events will change throughout the year.)

Event codes

EV18-AAA

EV18-BBB

EV19-DDD

<tbody>
</tbody>

EV18-AAA (for example, contains the logistics plan for the EV18-BBB event)

Who	Days before	Task	Status
Damien	200	Invite speakers	Complete
Chris	50	Meet sponsors	In progress
Damien	12	Book taxis	To do

<tbody>
</tbody>

ALL DATA (this is what this should look like)

Event code	Who	Days before	Task	Status
EV18-AAA	Damien	200	Invite speakers	Complete
EV18-AAA	Chris	50	Meet sponsors	In progress
EV18-AAA	Damien	12	Book taxis	To do
EV18-BBB	Damien	150	Invite speakers	Complete
EV19-DDD	Chris	100	Visit venues	In progress
EV19-DDD	Damien	80	Send emarketing	To do
EV19-DDD	Chris	40	Ask Jo to chair	In progress
EV19-DDD	Damien	12	Book taxis	To do

<tbody>
</tbody>

Could I have some help please with the VBA code to achieve this?

Note that there might be other event worksheets in the file, but ALL DATA should only pull through data from the worksheet names listed in ACTIVE EVENTS. There will be different numbers of rows in the logistics plans depending on the event. The data will start in the same row and column in each logistics worksheet (Cell A6). ALL DATA should also have a column that indicates which worksheet the logistics data has been pulled from (Column A in example above).

Thanks for your help.

Richard

 

[wideboydixon]

Book1
	A
1	Event codes
2	EV18-AAA
3	EV18-BBB
4	EV18-DDD
ACTIVE EVENTS

Book1
	A	B	C	D
6	Who	Days before	Task	Status
7	Damien	200	Invite speakers	Complete
8	Chris	50	Meet sponsors	In progress
9	Damien	12	Book taxis	To do
EV18-AAA

Book1
	A	B	C	D
6	Who	Days before	Task	Status
7	Damien	150	Invite speakers	Complete
EV18-BBB

Book1
	A	B	C	D
6	Who	Days before	Task	Status
7	Chris	100	Visit venues	In progress
8	Damien	80	Send emarketing	To do
9	Chris	40	Ask Jo to chair	In progress
10	Damien	12	Book taxis	To do
EV18-DDD

Book1
	A	B	C	D	E
1	Event Code	Who	Days before	Task	Status
2	EV18-AAA	Damien	200	Invite speakers	Complete
3	EV18-AAA	Chris	50	Meet sponsors	In progress
4	EV18-AAA	Damien	12	Book taxis	To do
5	EV18-BBB	Damien	150	Invite speakers	Complete
6	EV18-DDD	Chris	100	Visit venues	In progress
7	EV18-DDD	Damien	80	Send emarketing	To do
8	EV18-DDD	Chris	40	Ask Jo to chair	In progress
9	EV18-DDD	Damien	12	Book taxis	To do
ALL DATA

Private Const ActiveEventsTab = "ACTIVE EVENTS" ' Name of the tab holding active events
Private Const AllDataTab = "ALL DATA" ' Name of the tab holding all data
Private Const ActiveEventsData = "A1" ' Cell on the active events tab containing "Event Codes"
Private Const AllDataData = "A1" ' Cell on the all data tab containing "Event Code"
Private Const EventData = "A6" ' Cell on the event tab holding "Who"
Public Sub AggregateData()

Dim activeEventsSheet As Worksheet
Dim allDataSheet As Worksheet
Dim eventSheet As Worksheet
Dim lastEvent As Long
Dim thisEvent As Long
Dim lastAction As Long
Dim thisAction As Long
Dim nextRow As Long
Dim thisCol As Long

Set activeEventsSheet = Sheets(ActiveEventsTab)
Set allDataSheet = Sheets(AllDataTab)

' Clear existing data?
With allDataSheet
    lastEvent = .Cells(.Rows.Count, .Range(AllDataData).Column).End(xlUp).Row
    If lastEvent > .Range(AllDataData).Row Then
        .Range(.Cells(.Range(AllDataData).Row + 1, .Range(AllDataData).Column), .Cells(lastEvent, .Range(AllDataData).Column + 4)).ClearContents
    End If
End With

' Find last event
With activeEventsSheet
    lastEvent = .Cells(.Rows.Count, .Range(ActiveEventsData).Column).End(xlUp).Row
    If lastEvent <= .Range(ActiveEventsData).Row Then Exit Sub
End With

' Process all events
nextRow = allDataSheet.Range(AllDataData).Row + 1
For thisEvent = activeEventsSheet.Range(ActiveEventsData).Row + 1 To lastEvent
    Set eventSheet = Sheets(activeEventsSheet.Cells(thisEvent, activeEventsSheet.Range(ActiveEventsData).Column).Value)
    lastAction = eventSheet.Cells(eventSheet.Rows.Count, eventSheet.Range(EventData).Column).End(xlUp).Row
    If lastAction > eventSheet.Range(EventData).Row Then
        For thisAction = eventSheet.Range(EventData).Row + 1 To lastAction
            allDataSheet.Cells(nextRow, allDataSheet.Range(AllDataData).Column).Value = eventSheet.Name
            For thisCol = 1 To 4
                allDataSheet.Cells(nextRow, allDataSheet.Range(AllDataData).Column + thisCol).Value = eventSheet.Cells(thisAction, eventSheet.Range(EventData).Column + thisCol - 1).Value
            Next thisCol
            nextRow = nextRow + 1
        Next thisAction
    End If
Next thisEvent

End Sub

WBD

 

[Richard JIBS]

That works perfectly! Thanks very much.

Richard