Sub Resource_Load()
On Error Resume Next
Application.ScreenUpdating = False
Dim TaskNumber As Integer
Dim R As Integer
Dim N As Integer
Rws = 1
Rws2 = 1
N = 0
PJFile = Application.GetOpenFilename("All Files (*.*),*.*", 1, "Select MS Project Template", MultiSelect = False)
Dim appPJ As MSProject.Application
Set appPJ = CreateObject("MSProject.Application")
appPJ.Visible = True
appPJ.FileOpen Name:=PJFile, ReadOnly:=False, FormatID:="MSProject.MPP"
WindowSplit
ViewApply Name:="Tas&k Usage"
SelectTaskField Row:=1, Column:="Name", rowrelative:=False
For R = 1 To ActiveProject.Tasks.Count
TaskNumber = ActiveProject.Tasks(R).Text10
R = TaskNumber
SelectTaskField Row:=R + N, Column:="Name", rowrelative:=False
ObjTask = ActiveProject.Tasks(R).Name
Sheets("Summary Hrs").Activate
Columns("A:A").Select
Selection.Find(What:=TaskNumber, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Rws = ActiveCell.Row
Rws2 = Rws + 1
If Cells(Rws2, "C") <> "" Then
While Cells(Rws2, "E").Text <> ""
rescode = Cells(Rws2, "C").Text
hours = Cells(Rws2, "E").Text
WindowActivate WindowName:=PJFile
SelectTaskField Row:=0, Column:="Name", rowrelative:=True
ResourceAssignment Resources:=rescode & "[0%]", Operation:=pjAssign
Rws2 = Rws2 + 1
Wend
SelectTaskField Row:=1, Column:="Name"
For Each A In ActiveProject.Tasks(R).Assignments
ResourceName = A.ResourceName
Sheets("Summary Hrs").Activate
Columns("C:C").Select
Selection.Find(What:=ResourceName, After:=Cells(Rws, "C"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Rws2 = ActiveCell.Row
hours = Cells(Rws2, "E").Value
WindowActivate WindowName:=PJFile
SetResourceField Field:="Work", Value:=hours, AllSelectedResources:=True
SelectTaskField Row:=1, Column:="Name"
N = N + 1
Rws2 = 1
Next A
End If
Next R
End Sub