Manter arquivo original aberto quando salvar como

[Marcus Casanova Nogueira]

Estou usando esse código:

Sub ExecutarSalvarTXT()Dim NovoArquivoXLS As WorkbookDim nome As StringApplication.DisplayAlerts = FalseSheets("asa.in").Selectnome = Cells(1, 1).Value            'Cria um novo arquivo excel    Set NovoArquivoXLS = Application.Workbooks.Add    ActiveSheet.Name = nome    ActiveWorkbook.SaveAs ("C:\Users\marcus\Desktop" & "\" & nome), xlOpenXMLWorkbookMacroEnabled    'Copia a planilha para o novo arquivo criado        Windows("kkk.xlsm").Activate        Sheets("asa.in").Select        Sheets("asa.in").Copy Before:=Workbooks("1.xlsm").Sheets(1)            'Salva o arquivoActiveWorkbook.SaveAs Filename:="C:\Users\marcus\Desktop\" & nome, FileFormat:=xlTextWindows, ConflictResolution:=False        NovoArquivoXLS.Close    Set NovoArquivoXLS = Nothing    Application.DisplayAlerts = False        ActiveWindow.SelectedSheets.Delete      End Sub

No entanto, o arquivo original (kkk.xlsm) fecha quando o nome.txt é criado e esse nome.txt abre (como uma planilha do excel). Queria saber como faço para criar o txt e nada acontecer (não abrir o txt e nem fechar o original (kkk.xlsm))

 

Obrigado!

Marcus

[minoso]

Remova essas linhas

    NovoArquivoXLS.Close    Set NovoArquivoXLS = Nothing    Application.DisplayAlerts = False

[Marcus Casanova Nogueira]

Minoso,

Sub ExecutarSalvarTXT()Dim NovoArquivoXLS As WorkbookDim nome As StringApplication.DisplayAlerts = FalseSheets("asa.in").Selectnome = Cells(1, 1).Value            'Cria um novo arquivo excel    Set NovoArquivoXLS = Application.Workbooks.Add    ActiveSheet.Name = nome    ActiveWorkbook.SaveAs ("C:\Users\marcus\Desktop" & "\" & nome), xlOpenXMLWorkbookMacroEnabled    'Copia a planilha para o novo arquivo criado        Windows("kkk.xlsm").Activate        Sheets("asa.in").Select        Sheets("asa.in").Copy Before:=Workbooks("1.xlsm").Sheets(1)        Windows("1.xlsm").Activate        'Salva o arquivoActiveWorkbook.SaveAs Filename:="C:\Users\marcus\Desktop\\" & nome, FileFormat:=xlTextWindows, ConflictResolution:=FalseEnd Sub

o código esta assim agora. Ele não abre mais o 1.txt nem fecha mais a o aquivo kkk.xlsm, mas ele exclui a aba "asa.in" do "kkk.xlsm". Você sabe o porque?

 

Obrigado

[minoso]

Estranho...

 

Insere novamente as linhas removidas:

 

 

 

NovoArquivoXLS.Close
Set NovoArquivoXLS = Nothing
Application.DisplayAlerts = False

 

Mas agora delete apenas as linhas abaixo:

 

 

 

NovoArquivoXLS.Close
Application.DisplayAlerts = False

[Marcus Casanova Nogueira]

Minoso, mesmo deixando o código assim:

Sub ExecutarSalvarTXT()Dim NovoArquivoXLS As WorkbookDim nome As StringApplication.DisplayAlerts = FalseSheets("asa.in").Selectnome = Cells(1, 1).Value            'Cria um novo arquivo excel        Set NovoArquivoXLS = Application.Workbooks.Add        ActiveWorkbook.SaveAs ("C:\Users\marcus\Desktop" & "\" & "1"), xlOpenXMLWorkbookMacroEnabled    'Copia a planilha para o novo arquivo criado        Windows("kkk.xlsm").Activate        Sheets("asa.in").Select        Sheets("asa.in").Copy Before:=Workbooks("1.xlsm").Sheets(1)        Windows("1.xlsm").Activate    'Salva o arquivo       ActiveWorkbook.SaveAs Filename:="C:\Users\marcus\Desktop\USP\AERODESIGN\MIKE 2015\ASAS\" & nome, FileFormat:=xlTextWindows, ConflictResolution:=False               Set NovoArquivoXLS = Nothing                  End Sub

ainda a aba "asa.in" da pasta "kkk.xlsm" continua sendo excluida. Será que isso tem a ver com o comando "Sheets("asa.in").Copy Before:=Workbooks("1.xlsm").Sheets(1)" ?

 

Abraço

[minoso]

Você pode compartilhar o arquivo comigo aqui no fórum, por favor?

[Marcus Casanova Nogueira]

Opa! Como estava só testando o código, os arquivos são abas quaisquer, mas estão aí no anexo!

 

Abraço

kkkk.rar

[Marcus Casanova Nogueira]

Minoso, contornei esse problema deixando os dados da aba ''asa.in" na aba "principal" e a cada iteração eu crio a "asa.in" e copio os dados la. Assim ela pode ser excluída sem problemas, embora acrescente alguns cálculos a mais para o programa.

 

Abraço