Sub ResourceBaselineRollup()
Dim R As Resource
Dim A As Assignment
Dim aBL As TimeScaleValues
Dim rBL As TimeScaleValues
Dim Counter As Integer

For Each R In ActiveProject.Resources
    If Not (R Is Nothing) Then
        
        R.BaselineWork = 0
        
        For Each A In R.Assignments
            Set rBL = R.TimeScaleData(StartDate:=ActiveProject.ProjectSummaryTask.BaselineStart, _
            EndDate:=ActiveProject.ProjectSummaryTask.BaselineFinish, _
            Type:=pjResourceTimescaledBaselineWork, TimescaleUnit:=pjTimescaleDays, Count:=1)
            
            For Counter = 1 To rBL.Count
                rBL(Counter).Value = 0
            Next Counter
        Next A
        
        For Each A In R.Assignments
            R.BaselineWork = R.BaselineWork + A.BaselineWork
            
            Set aBL = A.TimeScaleData(StartDate:=ActiveProject.ProjectSummaryTask.BaselineStart, _
            EndDate:=ActiveProject.ProjectSummaryTask.BaselineFinish, _
            Type:=pjAssignmentTimescaledBaselineWork, TimescaleUnit:=pjTimescaleDays, Count:=1)
            
            Set rBL = R.TimeScaleData(StartDate:=ActiveProject.ProjectSummaryTask.BaselineStart, _
            EndDate:=ActiveProject.ProjectSummaryTask.BaselineFinish, _
            Type:=pjResourceTimescaledBaselineWork, TimescaleUnit:=pjTimescaleDays, Count:=1)
            
            For Counter = 1 To aBL.Count
                If Not (aBL(Counter).Value = "") Then
                    rBL(Counter).Value = rBL(Counter).Value + aBL(Counter).Value
                End If
            Next Counter
        Next A
    End If
Next R
End Sub