Boa tarde!!!

Eu precisaria entender melhor o que queres....

Quer que quando seu código rodar, seja contado toda vez de forma crescente..?

Poderia postar sua planilha?

Att..

Vou postar o codigo completo:
O que ele faz seria pegar de A3 ate T10 e colar estes dados na outra plan na celulas b ate a celula U da ultima linha vazia ( seria um historico) agora o que preciso seria obter um incremento na coluna V , como ja tenho dados cadastrados ele teria que incrementar apartir dali.

Sera que consegui explicar-me se houver duvida por favor de um alo...
por enquanto obrigado

Public Function ObtenhaUltimaCelula(rngCelulaInicial As Range) As Range
'Esta função retorna a última célula não vazia
'na coluna da célula passada em rngCelulaInicial
'
'Entenda-se, por vazia, uma célula NÃO PREENCHIDA,
'uma célula que contenha uma fórmula que retorne "" ou
'uma fórmula que contenha um erro como #VALOR! ou #N/D
Dim rngUltima As Range
Dim bSubir As Boolean
Set rngUltima = rngCelulaInicial.End(xlDown)
bSubir = True
While (bSubir)
If (Not IsError(rngUltima.Value)) Then
If ((Not IsEmpty(rngUltima.Value)) And _
(rngUltima.Value <> "")) Then
bSubir = False
End If
End If
If (bSubir) Then
If (rngUltima.Row > 1) Then
Set rngUltima = rngUltima.Offset(-1, 0)
Else
bSubir = False
End If
End If
Wend
Set ObtenhaUltimaCelula = rngUltima
End Function
Public Sub Selecione()
Dim rngInicio As Range, _
rngFim As Range, _
rngInterv As Range, _
rngLinha As Range
Set rngInicio = ObtenhaUltimaCelula(Range("$A$1"))
Set rngFim = ObtenhaUltimaCelula(Range("$B$1"))
Set rngInterv = Range(rngInicio, rngFim).EntireRow
rngInterv.Select
End Sub

Sub TransfereD()
'
Sheets("ModeloD").Select
If Range("A1").Value = "" Then

MsgBox "Você não Digitou uma DATA Valida para Inclusão", vbCritical, "Cadastro"
Exit Sub

Else

Sheets("ModeloD").Select
Range("$A$3:$t$10").Select ' linhas e colunas para transferir para o historico
Selection.Copy

Sheets("HistoricoD").Select
L = Sheets("HistoricoD").Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("B" & L).Select

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

For i = 1 To 8
Sheets("ModeloD").Select
Range("A1").Select
Selection.Copy

Sheets("HistoricoD").Select
L = Sheets("HistoricoD").Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & L).Select

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

Next i

Sheets("ModeloD").Select
Range("D13").Select
Range("C3:C13").Select
Selection.Copy
Range("B3").Select
ActiveSheet.Paste
Range("C18").Select
Worksheets("ModeloD").Range("c3:c13,g3:i13,m3:m13,r3:s13,a1").ClearContents
Worksheets("Dados").Range("A3:Q100").ClearContents

End If

End Sub

Consegui resolver ficou assim :
For i = 1 To 8
Sheets("ModeloD").Select
Range("A1").Select
Selection.Copy

Sheets("HistoricoD").Select
L = Sheets("HistoricoD").Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & L).Select

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

Range("v2").End(xlDown).Offset(1, 0) = Range("v2").End(xlDown) + 1

Selecione

Next i