COMPRADOR

estou transformando o arquivo para banco de dados em access. então vou postar no local correto. obrigada

oi consegui com o seguinte código: 
 
    'Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel 'Autor: Tomás Vásquez 'http://www.tomasvasquez.com.br 'http://tomas.vasquez.blog.uol.com.br 'março de 2008   Option Explicit     Const colENDEREÇO As Integer = 2 Const colCIDADE As Integer = 3 Const colREGIONAL As Integer = 4 Const colTIPO As Integer = 6 Const colÁREA_DISPONÍVEL_MP As Integer = 17 Const colLOCAÇÃO_MENSAL As Integer = 19 Const colVIGÊNCIA As Integer = 20 Const colMEMBRO As Integer = 34 Const COLSITUAÇÃO As Integer = 42   Const indiceMinimo As Byte = 2 Const corDisabledTextBox As Long = -2147483633 Const corEnabledTextBox As Long = -2147483643     Private wsCadastro As Worksheet Private wbCadastro As Workbook Private valor_pesquisado As String     Private Sub btnCancelar_Click()       Unload Me  frmCadastro.Show     End Sub     Private Sub frmRegistro_Click()   End Sub   Private Sub ListBox1_Click()   End Sub   Private Sub TxtRegional_Change() Application.DisplayAlerts = False Application.ScreenUpdating = False   valor_pesquisado = TxtRegional.Text   Call CarregaDadosInicial Call AtualizaFicha Call EnviarExcel Application.DisplayAlerts = True Application.ScreenUpdating = True   End Sub   Private Sub UserForm_Initialize() Application.DisplayAlerts = False Application.ScreenUpdating = False         Call DefinePlanilhaDados       Call Limpa          Call CarregaDadosInicial          Call EnviarExcel            TxtRegional.SetFocus          Application.ScreenUpdating = True     Application.DisplayAlerts = True      End Sub   Private Sub CarregaDadosInicial()          Dim linha As Integer     Dim coluna As Integer     Dim linhalistbox As Integer     Dim valor_celula As String     Dim conta_registros As Integer             linha = 2     coluna = 4 'coluna da busca na planilha     linhalistbox = 0     conta_registros = 0          ListBox1.Clear          With wsCadastro         While .Cells(linha, coluna).Value <> Empty             valor_celula = .Cells(linha, coluna).Value                          If UCase(Left(valor_celula, Len(valor_pesquisado))) = UCase(valor_pesquisado) Then                               With ListBox1                            ListBox1.ColumnWidths = "500;120;120;80;80;80;80;60;60"              .AddItem                 .List(linhalistbox, 0) = wsCadastro.Cells(linha, 2)                 .List(linhalistbox, 1) = wsCadastro.Cells(linha, 3)                 .List(linhalistbox, 2) = wsCadastro.Cells(linha, 4)                 .List(linhalistbox, 3) = wsCadastro.Cells(linha, 6)                 .List(linhalistbox, 4) = wsCadastro.Cells(linha, 17)                 .List(linhalistbox, 5) = Format(wsCadastro.Cells(linha, 19), "R$ #.###,##")                 .List(linhalistbox, 6) = Format(wsCadastro.Cells(linha, 20), "dd/mm/yyyy")                 .List(linhalistbox, 7) = wsCadastro.Cells(linha, 34)                 .List(linhalistbox, 8) = wsCadastro.Cells(linha, 42)                linhalistbox = linhalistbox + 1              conta_registros = conta_registros + 1              End With                              End If             linha = linha + 1         Wend     End With      If ListBox1.ListCount > 0 Then lbl_registros = ListBox1.ListCount - 1 Else lbl_registros = "0" End If      End Sub         Private Sub DefinePlanilhaDados()     Dim abrirArquivo As Boolean     Dim WB As Workbook     Dim caminhoCompleto As String     Dim ARQUIVO_DADOS As String     Dim PASTA_DADOS As String             abrirArquivo = True          ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value     PASTA_DADOS = Range("PASTA_DADOS").Value          If ThisWorkbook.Name <> ARQUIVO_DADOS Then         'monta a string do caminho completo         If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then             caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS         Else             If Right(PASTA_DADOS, 1) = "\" Then                 caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS             Else                 caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS             End If         End If                  'verifica se o arquivo não está aberto         For Each WB In Application.Workbooks             If WB.Name = ARQUIVO_DADOS Then                 abrirArquivo = False                 Exit For             End If         Next                  'atribui o arquivo         If abrirArquivo Then             Set wbCadastro = Workbooks.Open(FileName:=caminhoCompleto, ReadOnly:=True)         Else             Set wbCadastro = Workbooks(ARQUIVO_DADOS)         End If     Else         Set wbCadastro = ThisWorkbook     End If          Set wsCadastro = wbCadastro.Worksheets("REGISTRO ENDEREÇOS")          'oculta o arquivo de dados     wbCadastro.Windows(1).Visible = False               End Sub   Private Sub CommandButton2_Click()      If TxtRegional = "" Then    Exit Sub    Else             Call AtualizaFicha             Sheets("FICHA REGIONAL").Select             frmFichaRegional.Show    End If End Sub     Private Sub AtualizaFicha()       Application.DisplayAlerts = False     Application.ScreenUpdating = False        Sheets("FICHA REGIONAL").Select Range("C2") = Me.TxtRegional   Sheets("REGISTRO REGIONAIS").Select Range("a1").Select     Dim Rng As Range       Set Rng = Sheets("REGISTRO REGIONAIS").Cells.Find(What:=TxtRegional.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)              If Not Rng Is Nothing Then   Sheets("FICHA REGIONAL").Select    Sheets("FICHA REGIONAL").imgReg.Picture = LoadPicture(ThisWorkbook.Path & "\FOTOS UNIDADES\" & Rng.Offset(, 1)) Sheets("FICHA REGIONAL").imgReg.PictureSizeMode = fmPictureSizeModeStretch                     Application.DisplayAlerts = True     Application.ScreenUpdating = True              End If   End Sub   Private Sub EnviarExcel()       Application.DisplayAlerts = False     Application.ScreenUpdating = False 'cria varíavel para contagem da linha a ser preenchida Dim Nlin As Integer 'cria uma variável para contar as linhas da listbox Dim Cont As Integer   'limpa a região com dados anteriores Worksheets("FICHA REGIONAL").Range("A32:I1000").ClearContents   'linha inicial da planilha que carregará os dados Nlin = 31   'preenche as outras linhas até o fim da listbox For Cont = 0 To Me.ListBox1.ListCount - 1 Worksheets("FICHA REGIONAL").Range("A" & Nlin + 1) = Me.ListBox1.List(Cont, 0) Worksheets("FICHA REGIONAL").Range("B" & Nlin + 1) = Me.ListBox1.List(Cont, 1) Worksheets("FICHA REGIONAL").Range("C" & Nlin + 1) = Me.ListBox1.List(Cont, 2) Worksheets("FICHA REGIONAL").Range("D" & Nlin + 1) = Me.ListBox1.List(Cont, 3) Worksheets("FICHA REGIONAL").Range("E" & Nlin + 1) = Me.ListBox1.List(Cont, 4) Worksheets("FICHA REGIONAL").Range("F" & Nlin + 1) = Format(Me.ListBox1.List(Cont, 5), "R$ #.###,##") Worksheets("FICHA REGIONAL").Range("G" & Nlin + 1) = Format(Me.ListBox1.List(Cont, 6), "dd/mm/yyyy") Worksheets("FICHA REGIONAL").Range("H" & Nlin + 1) = Me.ListBox1.List(Cont, 7) Worksheets("FICHA REGIONAL").Range("I" & Nlin + 1) = Me.ListBox1.List(Cont, 8)     Nlin = Nlin + 1 Next       Application.DisplayAlerts = True     Application.ScreenUpdating = True End Sub     Sub Limpa()       Worksheets("FICHA REGIONAL").Select     Range("a32").Select     Range(Selection, Selection.End(xlToRight)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("a32").Select       On Error Resume Next        End Sub     Valeu a todos pela ajuda, e fica o código que consegui se alguém precisar. Obrigada

Deu certíssimo, muito obrigada mais uma vez Osvaldo!!