Inserir e Copiar dados de Formulário VBA

[Lenilson Gomes]

Bom dia Galera... Tudo na paz?

 

Estou com um formulário de Excel não tão básico assim que está mais da metade pronto falta apenas duas coisas para eu concluir o projeto.

1 - inserir sempre na primeira linha vazia (Achei que estava fácil, mas já tentei de tudo e nada dá certo... CERTEZA que estou fazendo besteira) os dados a partir da coluna A;

2 - Após inserir os dados no botão inserir tem um segundo passo que seria enviar o relatório e como teremos duas pessoas alterando a planilha ao mesmo tempo, criei duas abas uma para cada vendedora (BD_TEMP_V1 e BD_TEMP_V2) onde serão inseridos os dados temporários que apertando o botão enviar relatório devo copiar esses dados (a partir da linha 3 até a ultima preenchida) e colar numa outra aba (BD_TEMP_CONS).

Como teremos 2 pessoas inserindo dados eu gostaria que quando eu copiasse as informações ele não sobreescrevesse as que já estivessem coladas lá.

 

Segue o código que estou usando e a planilha com o exemplo:

 

'Sub LinhaVazia()
'Dim x As Integer
'x = ActiveSheet.UsedRange.Rows.Count
'ActiveCell.SpecialCells(xlLastCell).Select
'ActiveCell.EntireRow.Cells(1, 1).Offset(1, 0).Activate
'End Sub

Private Sub CommandButton1_Click()
ActiveSheet.Select
'posiciona o cursor na planilha cadastro
'Selection.End(xlDown).Select
''''''Vai para a ultima célula preenchida
Dim DLin As Long
DLin = Range("A:A").End(xlDown).Row + 1
'Do                                          ' Inicio do LOOP
'If IsEmpty(ActiveCell) = False Then         ' Verifica se posição tem ou não texto
    'ActiveCell.Offset(1, 0).Select

'End If                                      ' Fim de IF
'Cells(Rows.Count, "A").End(xlUp).Offset (1)
'cursor posicionado uma celula para baixo ( primeira em branco)
        ActiveCell.Offset(0, 0) = TextBox1.Text
        ActiveCell.Offset(0, 1) = TextBox2.Text
        ActiveCell.Offset(0, 2) = TextBox3.Text
        ActiveCell.Offset(0, 3) = TextBox7.Text
        ActiveCell.Offset(0, 4) = TextBox4.Text
        ActiveCell.Offset(0, 5) = TextBox5.Text
        ActiveCell.Offset(0, 6) = TextBox6.Text
        ActiveCell.Offset(0, 9) = TextBox10.Text
        ActiveCell.Offset(0, 10) = TextBox9.Text
        ActiveCell.Offset(0, 11) = TextBox11.Text
        'ActiveCell.Offset(0, 12) = TextBox12.Text
        ActiveCell.Offset(0, 16) = TextBox13.Text
        ActiveCell.Offset(0, 13) = TextBox8.Text
        'Insere as informações contidas no formulário em uma nova linha
        MsgBox "Dados inseridos", vbInformation, "Gerenciamento de Canhotos"
End Sub

Private Sub CommandButton2_Click()
  'Botão para salvar a pasta de trabalho.
    ActiveWorkbook.Save
    
End Sub

Private Sub MultiPage1_Change()

End Sub

  Sub OptionButton1_Click()
    If OptionButton1.Value = True Then
        Sheets("BD_TEMP_V1").Select
    End If
    End Sub

Private Sub OptionButton2_Click()
    If OptionButton2.Value = True Then
        Sheets("BD_TEMP_V2").Select
    End If
    End Sub

Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then
ActiveCell.Offset(0, 7) = "R"
End If
End Sub

Private Sub OptionButton4_Click()
If OptionButton4.Value = True Then
ActiveCell.Offset(0, 7) = "A"
End If
End Sub

Private Sub OptionButton5_Click()
If OptionButton5.Value = True Then
ActiveCell.Offset(0, 8) = "N"
End If
End Sub

Private Sub OptionButton6_Click()
If OptionButton6.Value = True Then
ActiveCell.Offset(0, 8) = "S"
End If
End Sub

'Mostra a data atual ao inicializar o formulário.
Private Sub UserForm_Initialize()

TextBox1 = Date

End Sub


Private Sub TextBox2_AfterUpdate()
'Aqui é selecionado a Planilha com seus dados (Plan2)
        With Plan3.Range("A:A")
 
        'Aqui onde será digitado o que procurar
 
        Set C = .Find(TextBox2.Value, LookIn:=xlValues, LOOKAT:=xlWhole)
        
        'Aqui outra tomada de decisão, caso encontre sua pesquisa, será retornado nas caixas de textbox.
        If Not C Is Nothing Then
            
            TextBox2.Text = C.Offset(0, 0)
            TextBox3.Text = C.Offset(0, 1)
            TextBox7.Text = C.Offset(0, 3)
            TextBox8.Text = C.Offset(0, 2)
                        
            'Fim da Pesquisa
       End If
                    
                                
        'Tomada de decisão em caso de não haver nenhum resultado
        If C Is Nothing Then
            
            TextBox2.SetFocus
            'Sua mensagem ao usuário aqui
            MsgBox ("CLIENTE NÃO ENCONTRADO"), vbOKOnly, ("Registro TMKT")
             'Volta para a primeira caixa de texto do formulário.
        
        'TextBox2.Text = ""
        End If
 
        'Fim da Pesquisa
    End With
    
End Sub

 

Relatorio_de_Ligações_Vendas_Internas.zip

[Lenilson Gomes]

Galera se eu estiver pedindo muito, serve só a função de inserir... o restante eu deixo manual mesmo.