Passar para Proxima linha no Excel

Bom dia, estou com problemas ao rodar o programa no excel, porém já fiz todas as dicas e não consigo resolver.
  Segue meu código

Public Sub Registro()

Dim Excel As Object
Dim Registro As String
Dim Funcionario As String
Dim Dataadmissao As String
Dim Datademissao As String
Dim Cargo As String
Dim Salario As String
Dim Comissionado As String
Dim Vtdiario As String
Dim Lojaregistro As String
Dim Pos As Integer

Dim ContLinha As Double
ContLinha = 1

Set Excel = CreateObject("Excel.Application")
Excel.Workbooks.Open Filename:="j:     este.xls"
Excel.Visible = True
Excel.Sheets("EstaPasta_de_trabalho").Select

Pos = 1
While Excel.Cells(Pos, 1) <> ""
        With Excel

            .Range("A" & CStr(ContLinha)).Select
            Registro = .ActiveCell.Value

            .Range("B" & CStr(ContLinha)).Select
            Funcionario = .ActiveCell.Value

            .Range("C" & CStr(ContLinha)).Select
            Dataadmissao = .ActiveCell.Value

            .Range("D" & CStr(ContLinha)).Select
            Datademissao = .ActiveCell.Value

            .Range("E" & CStr(ContLinha)).Select
            Cargo = .ActiveCell.Value

            .Range("F" & CStr(ContLinha)).Select
            Salario = .ActiveCell.Value

            .Range("G" & CStr(ContLinha)).Select
            Comissionado = .ActiveCell.Value

            .Range("H" & CStr(ContLinha)).Select
            Vtdiario = .ActiveCell.Value

            .Range("I" & CStr(ContLinha)).Select
            Lojaregistro = .ActiveCell.Value

            ContLinha = ContLinha + 1
        End With
        Pos = Pos + 1
Wend
Pos = Pos + 1

End Sub