Boa tarde galera.
Preciso de uma macro para exportar dados de uma planilha excel para txt., porém, as colunas que irei importar mudam de planilha para planilha, assim, teria que seleciona-las manualmente. Encontrei essa macro na internet que quase corresponde para o que preciso, porém, quando seleciono colunas intercaladas, ela não funciona. Alguém conseguiria me ajudar com isso? Agradeço muito. Anexei uma planilha como exemplo, onde as colunas em amarelo seriam as que eu precisaria exportar para txt. Segue a macro:
Sub ExportaTxt()
Dim delimitador As String
Dim infos As Integer
Dim Retorna As String
delimitador = " "
infos = MsgBox("Utilizar aspas ao redor das informações?", vbYesNo)
'Chama a função WriteFile passando as opções delimitador e aspas.
Retorna = WriteFile(delimitador, infos)
' Mostra a caixa de mensagem indicando que a operação está completa.
Select Case Retorna
Case "Canceled"
MsgBox "Operação Cancelada"
Case "Exported"
MsgBox "A informação foi exportada"
End Select
End Sub
'-------------------------------------------------------------------
Function WriteFile(delimiter As String, quotes As Integer) As String
' Dimensiona variáveis utilizadas.
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double
' Mostrar caixa de diálogo Salvar como com o nome do arquivo .TXT como padrão.
' Testa para ver que tipo de sistema esta macro está sendo executada.
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
Else
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"TEXT", , "Text Delimited Exporter")
End If
' Verifica se o cancelamento foi clicado.
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
' Obtem o próximo número de arquivo.
FNum = FreeFile()
' Abre o nome do arquivo selecionado para saída de dados.
Open SaveFileName For Output As #FNum
' Armazena o número total de linhas e colunas em variáveis.
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count
' Seleciona a Sheet desejada.
Sheets("Plan1").Activate
' Faz um loop em todas as células, da esquerda para a direita e de cima para baixo.
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
' Armazena o conteúdo atual das células em uma variável.
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
Case xlCenter
CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
Space(Abs(ColWidth - Len(.Text)) / 2)
Case Else
CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
End Select
End With
' Escreve o conteúdo para o arquivo.
' Com ou sem aspas ao redor da informação da célula.
Select Case quotes
Case vbYes
CellText = Chr(34) & CellText & Chr(34) & delimiter
Case vbNo
CellText = CellText & delimiter
End Select
Print #FNum, CellText;
' Atualiza a barra de status com o progresso.
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."
' Loop para a proxima coluna.
Next ColNum
' Adiciona um caractere de avanço de linha no final de cada linha.
If RowNum <> TotalRows Then Print #FNum, ""
' Loop para a proxima linha.
Next RowNum
' Fecha o arquivo .prn.
Close #FNum
' Redefine a barra de status.
Application.StatusBar = False
WriteFile = "Exported"
End Function
excel exemplo.xlsx