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