Boa TArde
estou com uma macro que importa txt , ate ai tudo ok , o que eu quero é , fazer varias importações , mantendo as anteriores.
Algens pode ajudar
segue codigo
Sub Importar()
Dim nString(0 To 14)
Dim LinhaDeTexto, Lin, Resp1, Resp2, Quant, Qual, nLin, Cont 'várias variáveis
Dim wsResumo As Worksheet
Set wsResumo = ThisWorkbook.Worksheets("Plan2") '
On Error GoTo InterrupçãoUsuário 'tratador de possíveis erros
If Plan1.Range("F2") = "" Then 'se a célula com o nome do arquivo for branco não faz nada
MsgBox "Preencha o nome do Arquivo que desaja Importar", vbInformation, "IMPORTAÇÃO DE ARQUIVOS"
Else
Resp1 = MsgBox("Deseja Importar", vbQuestion + vbYesNo, "IMPORTAÇÃO DE ARQUIVOS") 'se possuir nome do arquivo
If Resp1 = vbYes Then
Plan1.Range("g5") = 0 'começa o percentual de acompanhamento com zero "célula g5"
Qual = 1 'qual linha está sendo importada "começa com a 1"
'Lin = wsResumo.Range("B65536").End(xlUp).Row + 1 'define a linha que começará a importação na plan2'
Lin = wsResumo.Range("A" & Rows.Count).End(xlUp).Row + 1
Lin = 2
nLin = 2 'linha para controle do grupo do arquivo texto
Quant = FileLen(Plan1.Range("F2")) / 25000 'quantidade de linhas a serem importadas
Open Plan1.Range("F2") For Input As #1 ' Abre o arquivo.
Do While Not EOF(1) ' Faz o loop até o fim do arquivo.
Line Input #1, LinhaDeTexto ' Lê a linha para a variável.
If LinhaDeTexto = "" Then ' se a linha a ser importada for branca não faz nada
Qual = Qual + 1 / 2
ElseIf IsNumeric(Trim(Left(LinhaDeTexto, 2))) Then 'se os 2 primeiros digitis da linha a ser importada for numerico então importa
nString(0) = Trim(Left(LinhaDeTexto, 2)) & "." & Trim(Right(Left(LinhaDeTexto, 4), 3)) 'os strings são as divisões do arquivo texto
nString(1) = Trim(Right(Left(LinhaDeTexto, 73), 40)) 'nome'
nString(2) = Trim(Right(Left(LinhaDeTexto, 478), 55)) 'endereco'
nString(3) = Trim(Right(Left(LinhaDeTexto, 483), 5)) 'numero'
nString(4) = Trim(Right(Left(LinhaDeTexto, 557), 34)) 'bairro'
nString(5) = Trim(Right(Left(LinhaDeTexto, 607), 50)) 'cidade'
nString(6) = Trim(Right(Left(LinhaDeTexto, 610), 3)) 'estado'
nString(7) = Trim(Right(Left(LinhaDeTexto, 423), 10)) 'cep'
nString(
= Trim(Right(Left(LinhaDeTexto, 32), 11)) 'cpf'
nString(9) = Trim(Right(Left(LinhaDeTexto, 1642), 19)) 'cartao'
nString(10) = Trim(Right(Left(LinhaDeTexto, 1657), 1)) 'status'
Plan2.Range("A" & Lin) = nString(0)
Plan2.Range("B" & Lin) = nString(1)
Plan2.Range("C" & Lin) = nString(2)
Plan2.Range("D" & Lin) = nString(3)
Plan2.Range("E" & Lin) = nString(4)
Plan2.Range("F" & Lin) = nString(5)
Plan2.Range("G" & Lin) = nString(6)
Plan2.Range("H" & Lin) = nString(7)
Plan2.Range("I" & Lin) = nString(
Plan2.Range("J" & Lin) = nString(9)
Plan2.Range("K" & Lin) = nString(10)
Qual = Qual + 1 'aumenta uma contagem a linha a ser importada
Lin = Lin + 1 'aumenta uma linha na plan2
ElseIf Trim(Left(LinhaDeTexto, 5)) = "TOTAL" Then 'se a linha a ser importada começas com TOTAL então volta e preenche o grupo
For Cont = nLin To Lin - 1
Plan2.Range("P" & Cont) = Trim(Right(Left(LinhaDeTexto, 39), 24))
nLin = nLin + 1
Next
Qual = Qual + 1
End If
DoEvents
Plan1.Range("g5") = Format(Qual / Quant, "0.00%") 'atualiza o percentual de acompanhamento
Plan1.Range("h5") = (Val(Plan1.Range("g5"))) * 0.9
DoEvents
Loop
Close #1
Plan1.Range("g5") = Format(1, "0.00%")
Plan1.Range("h5") = (Val(Plan1.Range("g5"))) * 0.9
Resp2 = MsgBox("IMPORTAÇÃO FINALIZADA !", vbInformation, "IMPORTAÇÃO DE ARQUIVOS")
End If
End If
Exit Sub
InterrupçãoUsuário:
MsgBox "OCORREU UM ERRO! " & Chr(10) & Err.Number & " - " & Err.Description & Chr(10) & LinhaDeTexto, 48, "ZIM"
Close #1
End Sub