How do I make multiple drop down lists in multiple cells using VBA?

[DreyFox]

I have a sheet with 1000 rows of data. I'd like to make a drop-down using VBA for say all 1000 rows in Column I. I have the following code to make it for a single cell:

With Range("I2").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:= xlBetween, Formula1:="=650,400,500-1,500-2,4600,ETM,T4-1,T6-1,T8-1"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub

But I have no idea how to replicate this for the next following thousand cells. Please help me. Thank you.

 

[GWteB]

How about ...

Sub DreyFox()
    With Range("I2:I1000").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="650,400,500-1,500-2,4600,ETM,T4-1,T6-1,T8-1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

 

[DreyFox]

How about ...

Sub DreyFox()
    With Range("I2:I1000").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="650,400,500-1,500-2,4600,ETM,T4-1,T6-1,T8-1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Lol I'm dumb. Thank you!