Notifications
Clear all

cadastrar os dados abaixo da última linha preenchida

2 Posts
2 Usuários
0 Reactions
1,662 Visualizações
(@lzm11)
Posts: 0
New Member
Topic starter
 

Boa tarde,

Tenho uma planilha simples de cadastro de dados, porém ao preencher aos dados e registrar para o excel copiá-los na planilha, ele fica substituindo os dados em uma mesma linha. Não reconhece que deveria colocar os dados na linha que está disponível abaixo da última preenchida

Poderiam, por gentileza, me ajudar?

Private Sub CommandButton1_Click()
Dim UltimaLinhas As Long
UltimaLinha = Sheets("BookLog").Cells(Cells.Rows.Count, 1).End(xlUp).Row
If UltimaLinha < 7 Then
UltimaLinha = 7
Else
UltimaLinha = UltimaLinha + 1
End If


Range("B" & UltimaLinha).Value = TextBox2.Text


If OptionButton1.Value = True Then
    Range("C" & UltimaLinha).Value = OptionButton1.Caption
ElseIf OptionButton2.Value = True Then
    Range("C" & UltimaLinha).Value = OptionButton2.Caption
ElseIf OptionButton3.Value = True Then
    Range("C" & UltimaLinha).Value = OptionButton3.Caption
End If


If OptionButton4.Value = True Then
    Range("D" & UltimaLinha).Value = OptionButton4.Caption
ElseIf OptionButton5.Value = True Then
    Range("D" & UltimaLinha).Value = OptionButton5.Caption
ElseIf OptionButton6.Value = True Then
    Range("D" & UltimaLinha).Value = OptionButton6.Caption
End If


If OptionButton7.Value = True Then
    Range("E" & UltimaLinha).Value = OptionButton7.Caption
ElseIf OptionButton8.Value = True Then
    Range("E" & UltimaLinha).Value = OptionButton8.Caption
ElseIf OptionButton9.Value = True Then
    Range("E" & UltimaLinha).Value = OptionButton9.Caption
End If


If OptionButton10.Value = True Then
    Range("F" & UltimaLinha).Value = OptionButton10.Caption
ElseIf OptionButton11.Value = True Then
    Range("F" & UltimaLinha).Value = OptionButton11.Caption
ElseIf OptionButton12.Value = True Then
    Range("F" & UltimaLinha).Value = OptionButton12.Caption
End If


Range("G" & UltimaLinha).Value = TextBox3.Text

Range("H" & UltimaLinha).Value = TextBox4.Text

lsLimparTextBox UserForm1
    
    MsgBox "Cadastro Realizado com Sucesso!", vbDefaultButton1, "CADASTRO DE DADOS"
    TextBox2.SetFocus


End Sub

Private Sub lsInserir(ByRef lTextBox As Variant, ByVal lSheet As String, ByVal lColunaCodigo As Long, ByVal lUltimaLinha As Long)
    If (TypeOf lTextBox Is MSForms.TextBox) Or (TypeOf lTextBox Is MSForms.ComboBox) Then
        Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Text
    Else
        If TypeOf lTextBox Is MSForms.OptionButton Then
            If lTextBox.Value = True Then
                Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Caption
            End If
        End If
    End If
End Sub



Public Function lsInserirTextBox(formulario As UserForm, ByVal lSheet As String, ByVal lColunaCodigo As Long)
    Dim controle            As Control
    Dim lUltimaLinhaAtiva   As Long
    
    lUltimaLinhaAtiva = Worksheets(lSheet).Cells(Worksheets(lSheet).Rows.Count, lColunaCodigo).End(xlUp).Row + 1
    
    For Each controle In formulario.Controls
        lsInserir controle, lSheet, lColunaCodigo, lUltimaLinhaAtiva
    Next
End Function


Public Function lsLimparTextBox(formulario As UserForm)
    Dim controle            As Control
    
    For Each controle In formulario.Controls
        If TypeOf controle Is MSForms.TextBox Then
            controle.Text = ""
        End If
    Next
End Function


Private Sub CommandButton2_Click()
    lsLimparTextBox frmCadastro
    
    TextBox1.SetFocus
End Sub

Private Sub TextBox2_Change()
If Len(TextBox2) = 2 Or Len(TextBox2) = 5 Then
        TextBox2.Text = TextBox2.Text & "/"
        SendKeys "{End}", True
    End If
End Sub


Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

   TextBox2.MaxLength = 10
 
    If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
End Sub
 
Postado : 03/10/2019 11:29 am
(@coutinho)
Posts: 0
New Member
 

Izm11, primeiro gostaria de solicitar que qdo colocar Rotinas (macros) utiliza a Tag "Code".

Sem conhecer a estrutura de seu modelo vou na suposição, no inicio da rotina, voce verifica qual a ultima linha preenchida :

Esta efetuando verificação na Coluna "A"

UltimaLinha = Sheets("BookLog").Cells(Cells.Rows.Count, 1).End(xlUp).Row

E efetuando lançamentos na coluna "B" e outras :

Range("B" & UltimaLinha).Value = TextBox2.Text

Então, acredito que, se não fizer nenhum lançamento na coluna "A", a contagem será sempre a mesma.

Veja se é isso, se não, detalhe melhor ou poste seu modelo colocando o arquivo no SendSpace e colando o link aqui.

[]s

Mauro Coutinho
Administrador

 
Postado : 03/10/2019 11:53 am