Gerar contador

2024 - VBA & Macros

Post Recente por Fernando Fernandes 11 anos atrás

3 Posts

3 Usuários

0 Reactions

828 Visualizações

RSS

valdecirrk

(@valdecirrk)

Posts: 230

Estimable Member

Topic starter

Bom dia

Tenho esta linha de comando mas quero que ao gravar gere um contador automático, não estou conseguindo fazer ele gerar o próximo valor quando salvo.

Sub Gravar()
Dim itotallinhas As Integer
Dim lUltima As Long

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Dados").Activate
'Selecionar a célula A3
Range("A2").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

itotallinhas = Sheets("Dados").Cells(Rows.Count, 1).End(xlUp).Row + 1
lUltima = Sheets("Dados").Cells(itotallinhas - 1, 1).Value + 1

'Carregar os dados digitados nas caixas de texto para a planilha

ActiveCell.Offset(0, 1).Value = FrmTerceiros.TextBox18.Value
ActiveCell.Offset(0, 2).Value = FrmTerceiros.Label21.Caption
ActiveCell.Offset(0, 3).Value = FrmTerceiros.TextBox11.Value
ActiveCell.Offset(0, 4).Value = FrmTerceiros.TextBox8.Value
ActiveCell.Offset(0, 5).Value = FrmTerceiros.TextBox9.Value

Postado : 10/01/2014 5:27 am

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

valdecirrk,

Bom Dia!

Utilize assim:

Sub Gravar()
Dim itotallinhas As Integer
Dim lUltima As Long

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Dados").Activate
'Selecionar a célula A3
Range("A2").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
itotallinhas = Sheets("Dados").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Loop Until IsEmpty(ActiveCell) = True

lUltima = Sheets("Dados").Cells(itotallinhas - 1, 1).Value + 1




'Carregar os dados digitados nas caixas de texto para a planilha

ActiveCell.Offset(0, 1).Value = FrmTerceiros.TextBox18.Value
ActiveCell.Offset(0, 2).Value = FrmTerceiros.Label21.Caption
ActiveCell.Offset(0, 3).Value = FrmTerceiros.TextBox11.Value
ActiveCell.Offset(0, 4).Value = FrmTerceiros.TextBox8.Value
ActiveCell.Offset(0, 5).Value = FrmTerceiros.TextBox9.Value

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 10/01/2014 7:30 am