VBA – copy rows of data from specified worksheets

Richard JIBS

New Member
Joined
Feb 3, 2015
Messages
13
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.)

[TABLE="width: 500"]
<tbody>[TR]
[TD]Event codes[/TD]
[/TR]
[TR]
[TD]EV18-AAA[/TD]
[/TR]
[TR]
[TD]EV18-BBB[/TD]
[/TR]
[TR]
[TD]EV19-DDD[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 500"]
<tbody>[TR]
[TD]Who [/TD]
[TD]Days before[/TD]
[TD]Task [/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]Damien[/TD]
[TD]200[/TD]
[TD]Invite speakers[/TD]
[TD]Complete[/TD]
[/TR]
[TR]
[TD]Chris[/TD]
[TD]50[/TD]
[TD]Meet sponsors[/TD]
[TD]In progress[/TD]
[/TR]
[TR]
[TD]Damien[/TD]
[TD]12[/TD]
[TD]Book taxis[/TD]
[TD]To do[/TD]
[/TR]
</tbody>[/TABLE]

ALL DATA (this is what this should look like)

[TABLE="width: 600"]
<tbody>[TR]
[TD]Event code[/TD]
[TD]Who [/TD]
[TD]Days before[/TD]
[TD]Task [/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]EV18-AAA[/TD]
[TD]Damien[/TD]
[TD]200[/TD]
[TD]Invite speakers[/TD]
[TD]Complete[/TD]
[/TR]
[TR]
[TD]EV18-AAA[/TD]
[TD]Chris[/TD]
[TD]50[/TD]
[TD]Meet sponsors[/TD]
[TD]In progress[/TD]
[/TR]
[TR]
[TD]EV18-AAA[/TD]
[TD]Damien[/TD]
[TD]12[/TD]
[TD]Book taxis[/TD]
[TD]To do[/TD]
[/TR]
[TR]
[TD]EV18-BBB[/TD]
[TD]Damien[/TD]
[TD]150[/TD]
[TD]Invite speakers[/TD]
[TD]Complete[/TD]
[/TR]
[TR]
[TD]EV19-DDD[/TD]
[TD]Chris[/TD]
[TD]100[/TD]
[TD]Visit venues[/TD]
[TD]In progress[/TD]
[/TR]
[TR]
[TD]EV19-DDD[/TD]
[TD]Damien[/TD]
[TD]80[/TD]
[TD]Send emarketing[/TD]
[TD]To do[/TD]
[/TR]
[TR]
[TD]EV19-DDD[/TD]
[TD]Chris[/TD]
[TD]40[/TD]
[TD]Ask Jo to chair[/TD]
[TD]In progress[/TD]
[/TR]
[TR]
[TD]EV19-DDD[/TD]
[TD]Damien[/TD]
[TD]12[/TD]
[TD]Book taxis[/TD]
[TD]To do[/TD]
[/TR]
</tbody>[/TABLE]

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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

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



Book1
ABCD
6WhoDays beforeTaskStatus
7Damien200Invite speakersComplete
8Chris50Meet sponsorsIn progress
9Damien12Book taxisTo do
EV18-AAA



Book1
ABCD
6WhoDays beforeTaskStatus
7Damien150Invite speakersComplete
EV18-BBB



Book1
ABCD
6WhoDays beforeTaskStatus
7Chris100Visit venuesIn progress
8Damien80Send emarketingTo do
9Chris40Ask Jo to chairIn progress
10Damien12Book taxisTo do
EV18-DDD



Book1
ABCDE
1Event CodeWhoDays beforeTaskStatus
2EV18-AAADamien200Invite speakersComplete
3EV18-AAAChris50Meet sponsorsIn progress
4EV18-AAADamien12Book taxisTo do
5EV18-BBBDamien150Invite speakersComplete
6EV18-DDDChris100Visit venuesIn progress
7EV18-DDDDamien80Send emarketingTo do
8EV18-DDDChris40Ask Jo to chairIn progress
9EV18-DDDDamien12Book taxisTo do
ALL DATA


Code:
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
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,022
Latest member
RobertV1609

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
Back
Top