1
I am developing a script for Excel, which copies specific fields from one sheet, and pastes into another, takes the name of the A9 cell and saves a file with the data copied with the name of the A9 cell in format . txt, after deleting the A9 line and continues the loop until it reaches the A9 cell without values, the script for this works as I want, but I’m breaking my head is to save this . txt inside the folder that also the script creates with A9 cell name.
EX: C: user desktop Saves 001 001.txt, C: user desktop Saves 002 002.txt, C: user desktop Saves 003 003.txt and so on.
someone could help me?
below the code I am using:
Sub CriarNovaPlanilha()
linha = 9
Do Until Cells(linha, 1) = ""
Application.DisplayAlerts = False
' declara as variáveis
Dim ultimaPlanilha As Integer
Dim planilhaVerificada As Integer
' define a última planilha com nome Dados encontrada,
' o 0 (zero) indica que ainda não foi encontrada
ultimaPlanilha = 0
' desativa atualização de tela
Application.ScreenUpdating = False
' adiciona nova planilha no final
Sheets.Add After:=Sheets(Sheets.Count)
' percorre todas as planilhas existentes
For i = 1 To Sheets.Count Step 1
' verifica os nomes das planilhas
If Sheets(i).Name = "Dados" And ultimaPlanilha = 0 Then
' define que foi encontrada uma planilha com nome Dados
ultimaPlanilha = 1
ElseIf Sheets(i).Name Like "Dados (*)" Then
' pega o número que está entre os parênteses
planilhaVerificada = CInt(Mid(Sheets(i).Name, 6, Len(Sheets(i).Name) - 6))
' verifica o número da planilha atual com o número da última encontrada
If planilhaVerificada > ultimaPlanilha Then
' define o número da última planilha encontrada
ultimaPlanilha = planilhaVerificada
End If
End If
Next i
' seleciona a planiha atual
Sheets(Sheets.Count).Select
' verifica qual o nome deverá ser considerado
If ultimaPlanilha = 0 Then
Sheets(Sheets.Count).Name = "Dados"
Else
Sheets(Sheets.Count).Name = "Dados (" & CStr(ultimaPlanilha + 1) & ")"
End If
' ativa atualização de tela
Application.ScreenUpdating = True
'Cria a pasta com o nome da Celula A9
Dim pasta As Object, nomePasta
Set pasta = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
nomePasta = ThisWorkbook.Path & "\" & Planilha1.Cells(9, 1).Value
If Not pasta.FolderExists(nomePasta) Then
pasta.CreateFolder (nomePasta)
End If
'Copia os dados definidos da plan1
Sheets("plan1").Select
Dim Nome As String
Nome = Planilha1.Range("A9").Text
Range("C1:C6").Select
Selection.Copy
Sheets("Dados").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("A9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("F9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("G9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B5").Select
ActiveSheet.Paste
Sheets("plan1").Select
Range("H9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dados").Select
Range("B6").Select
ActiveSheet.Paste
Sheets("Dados").Select
Application.CutCopyMode = False
Sheets("Dados").Move
'Salva os dados copiados em formato .txt
ActiveWorkbook.SaveAs Filename:="C:\Users\arthu\Desktop\save\" & Nome & ".txt", _
FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Rows("9:9").Select
Range("G9").Activate
Selection.Delete Shift:=xlUp
Loop
Application.DisplayAlerts = True
End Sub