Basta usar a ferrramenta auto preenchimento

selecione B2

Coloque o cursor no canto inferior direito da celula o cursor vai mudar de cor e ficar preto

Basta dar dois cliques vai copiar ate a ultima linha preenchida da coluna A

Se quiser por VBA, utilize a rotina abaixo :

Sub AutoFill()

    Dim Ultimalinha As Long
    
    Ultimalinha = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("B2").AutoFill Destination:=Range("B2:" & "B" & Ultimalinha)

End Sub

Mauro deu certo! Agora caso eu queira copiar e colar valores as da celula B4:B FIM, como faria ?

 

Boa noite, igormdiniz.

Tenta assim:

Sub AutoFill()

    Dim Ultimalinha As Long
    
    Ultimalinha = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("B2").AutoFill Destination:=Range("B2:" & "B" & Ultimalinha)
	
	Range("B2:" & "B" & Ultimalinha).Copy
	
	Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
		
	Application.CutCopyMode = False


End Sub

Eu não gosto muito de utilizar o selection, pois dependendo de onde estiver o cursor vai colar no lugar errado, para evitar isto pode determinar na rotina para onde devemos colar :

Abaixo estamos copiando e colando somete os valores para a coluna "C", se for para outra ou para a mesma é só alterar a letra .

Sub AutoFill_Copy_Values()

    Dim Ultimalinha As Long
    
    Ultimalinha = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("B2").AutoFill Destination:=Range("B2:" & "B" & Ultimalinha)
   
    Range("B2:" & "B" & Ultimalinha).Copy
    
    'Se for para copiar e colar na mesma coluna, só altere as letras
    'Cola só os valores na coluna C
    ActiveSheet.Range("C2:" & "C" & Ultimalinha).PasteSpecial xlPasteValues

    Application.CutCopyMode = False

End Sub