[Como executar um Loop que percorra todas as linhas de uma coluna sem travar]

Como executar um Loop que percorra todas as linhas de uma coluna sem travar, exemplo

Sub MacroDB()

Application.ScreenUpdating = False

teste = 1

Coluna =1

ValorS = Range("I4")

Do While teste <> 1

Range("I4").Select
Selection.Copy

    If Cells(1, Coluna) = "" Then
    
    Cells(1, Coluna).Select
    
        ElseIf Cells(2, Coluna) = "" Then
        
        Cells(2, Coluna).Select
    
            Else
            
            Cells(1, Coluna).End(xlDown).Offset(1, 0).Select

    End If

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        

loop