I wanted to put the award information for each row back into the Award
worksheet.

Here are the changes

Sub MakeBuckets()

Const AmountCol As String = "C"
Const TempShtName As String = "Temporary"

Dim percent As Single
Dim RangeTotal As Single

Set AwardSht = Sheets("Awards")
Set ContractSht = Sheets("Contracts")

Application.DisplayAlerts = False

'Delete all worksheets except Awards and Contracts
For ShtCount = Sheets.Count To 1 Step -1
If Sheets(ShtCount).Name < "Awards" And _
Sheets(ShtCount).Name < "Contracts" Then

Sheets(ShtCount).Delete
End If
Next ShtCount

'create temporary sheet for making buckets
Set Tmpsht = Sheets.Add(after:=Sheets(Sheets.Count))
Tmpsht.Name = TempShtName

With AwardSht
'add header row info
.Range("A1") = "%"
.Range("B1") = "Min"
.Range("C1") = "Max"
.Range("D1") = "Range Total"
.Range("E1") = "Expected Award"
.Range("F1") = "Actual Award"
.Range("G1") = "Actual %"

'get each bucket
RowCount = 2
Do While .Range("A" & RowCount) < ""

With Tmpsht
'turn off autofilter
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With

percent = .Range("A" & RowCount)
MinAward = .Range("B" & RowCount)
MaxAward = .Range("C" & RowCount)

'only copy award range once if there are multiple
'awards in the same range
If MinAward < .Range("B" & (RowCount - 1)) Or _
MaxAward < .Range("C" & (RowCount - 1)) Then

With ContractSht
'turn off autofilter
If .AutoFilterMode Then
.Cells.AutoFilter
End If

LastRow = .Range(AmountCol & Rows.Count).End(xlUp).Row
With .Columns(AmountCol & ":" & AmountCol)
.AutoFilter
End With


.Range(AmountCol & "2:" & AmountCol & LastRow).AutoFilter _
Field:=1, _
Criteria1:="=" & MinAward, _
Operator:=xlAnd, _
Criteria2:="<" & MaxAward

'clear temporary sheet
Tmpsht.Cells.ClearContents

'copy filtered data to temporary sheet
.Cells.SpecialCells(Type:=xlCellTypeVisible).Copy _
Destination:=Tmpsht.Cells


'sort contracts highest to lowest
LastRow = .Range(AmountCol & Rows.Count).End(xlUp).Row
.Rows("1:" & LastRow).Sort _
key1:=.Range(AmountCol & "1"), _
order1:=xlDescending


'Get Grand Total for range
RangeTotal = Evaluate( _
"Sum(" & TempShtName & "!" & AmountCol & "2:" & _
AmountCol & LastRow & ")")

End With

End If

Award = RangeTotal * percent
Call GetContracts(TempShtName, AmountCol, Award)

'create Range sheet sheet for making buckets
shtname = "(" & (RowCount - 1) & ") " & MinAward & " - " & MaxAward

Set RangeSht = Sheets.Add(after:=Sheets(Sheets.Count))
RangeSht.Name = shtname

With Tmpsht

'copy filtered data to Award sheet
.Cells.SpecialCells(Type:=xlCellTypeVisible).Copy _
Destination:=RangeSht.Cells

End With


With RangeSht
'remove column IV from the Award sheet
.Columns("IV").Delete

'Get Last row
LastRow = .Range(AmountCol & Rows.Count).End(xlUp).Row
SummaryRow = LastRow + 2
'put formula total columns
.Range(AmountCol & SummaryRow).Offset(0, -1) = "Total Awards"
.Range(AmountCol & SummaryRow).Offset(0, 0).Formula = _
"=SUM(" & AmountCol & "2:" & AmountCol & LastRow & ")"
Total = .Range(AmountCol & SummaryRow).Offset(0, 0)
.Range(AmountCol & SummaryRow).Offset(1, -1) = "Total Range"
.Range(AmountCol & SummaryRow).Offset(1, 0) = RangeTotal
.Range(AmountCol & SummaryRow).Offset(2, -1) = "Expected Award"
.Range(AmountCol & SummaryRow).Offset(2, 0) = RangeTotal * percent
.Range(AmountCol & SummaryRow).Offset(3, -1) = "Expected Percent"
.Range(AmountCol & SummaryRow).Offset(3, 0) = percent
.Range(AmountCol & SummaryRow).Offset(4, -1) = "Actual Percent"
.Range(AmountCol & SummaryRow).Offset(4, 0) = Total / RangeTotal

.Columns.AutoFit
End With

With AwardSht
.Range("D" & RowCount) = RangeTotal
.Range("E" & RowCount) = RangeTotal * percent
.Range("F" & RowCount) = Total
.Range("G" & RowCount) = Total / RangeTotal
End With

RowCount = RowCount + 1
Loop
End With

With ContractSht
'turn off autofilter
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With

With AwardSht
.Columns.AutoFit
End With

Application.DisplayAlerts = False

End Sub
Sub GetContracts(ByVal shtname As String, ByVal AmountCol As String, _
ByVal Award As Single)

'sub routine to get a percentage of the contracts in a range
'filter the worksheet
'main routine will copy the filtered data

With Sheets(shtname)
'replace any awarded contract with an X in column IV with A (awarded)
'this is so the same contract doesn't get awarded twice
.Columns("IV").Replace _
What:="X", _
Replacement:="A", _
LookAt:=xlWhole


LastRow = .Range(AmountCol & Rows.Count).End(xlUp).Row


Total = 0
'put an X in column IV for every contract that keeps total under Awards
For RowCount = 2 To LastRow
'test if contract already awareded
If .Range("IV" & RowCount) < "A" Then
Amount = .Range(AmountCol & RowCount)
If Amount + Total <= Award Then
.Range("IV" & RowCount) = "X"
Total = Total + Amount
End If
End If
Next RowCount

'check if ther is filtered data
Cellsnotempty = Evaluate("Counta(" & shtname & "!IV:IV)")

If Cellsnotempty 0 Then

'filter on formula in column IV
With .Columns("IV:IV")
.AutoFilter
End With


.Range("IV2:IV" & LastRow).AutoFilter _
Field:=1, _
Criteria1:="X"
End If

End With


End Sub