Sub Optimum()
Dim myTable1 As ListObject
Dim myArray1 As Variant
Dim myTable2 As ListObject
Dim myArray2 As Variant
Dim newrow As ListRow
Set myTable1 = Sheets("Mod 5 CR").ListObjects("Table8")
Set myTable2 = Sheets("Sheet5").ListObjects("Table7")
Set myArray1 = myTable2.ListColumns(1).Range
For Each cell In myArray1
If cell.Value >= Sheets("Mod 5 CR").Range("B20").Value And cell.Value <= Sheets("Mod 5 CR").Range("B18").Value Then
Set newrow = myTable1.ListRows.Add
With newrow
.Range(1).Value = cell.Value
.Range(2).Value = Cells(cell.Row, 3).Value
.Range(3).Value = Cells(cell.Row, 8).Value
.Range(4).Value = Cells(cell.Row, 23).Value
.Range(5).Value = Cells(cell.Row, 4).Value
End With
End If
Next cell
End Sub