Dim copycars(), cars(2), x
Redim copycars(0)
x = 0
cars(0) = "Ford"
cars(1) = "Audi"
cars(2) = "Prius"
Do Until x = ubound(cars)
copycars(ubound(copycars)) = cars(x)
redim preserve copycars(ubound(copycars)+1)
x = x + 1
Loop
redim preserve copycars(ubound(copycars)-1) 'trim off the empty last entry