VBA Script Help for excel

Asked

Viewed 40 times

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

1 answer

1


Hello!

How are you?

I tested your code (obviously adapting to save the files in my folders) and the result was that the code created a folder with the value of the A9 cell in the same folder where the sheet was saved and the file. txt was saved to another folder inside the " C:\ " .

From what I understand from your question, you want to save the . txt inside the folder created with the value of cell A9 (which is created in the same worksheet path that performs this operation). That’s it?

If it is, all you need to do is change the path in which . txt is saved. Just do this:

ActiveWorkbook.SaveAs Filename:=nomePasta & "\" & Nome & ".txt", _
        FileFormat:=xlUnicodeText, CreateBackup:=False

This is because the variable "folder name" stored the path of the folder created with the value of cell A9.

Originally, your spreadsheet was targeting to save . txt to a new folder called "save" inside " C: " at the end of the code.

If your intention, on the other hand, is to create the folder with the A9 cell value inside the "save" folder, you also need to change the code assigned to the "folder name" variable to:

C:\Users\arthu\Desktop\save\

In place of:

ThisWorkbook.Path

If it doesn’t work, let me know.

Browser other questions tagged

You are not signed in. Login or sign up in order to post.