Ajuda com repetições em VBA

[Aillsom Dias]

Pessoal,

Eu não domino VBA e quero fazer algo muito simples, mas como não sei os nomes das funções, gostaria de saber se pode me ajudar a organizar a rotina abaixo:

Eu tenho um arquivo em excel, quero copiar o conteúdo da linha D(D1:AQ1), colar transposto em outra planilha e salvar esta nova como um arquivo .txt.

A rotina abaixo faz isso, porém, não sei como fazer para que ela se repita indefinidamente até a linha 300, ou seja, tenho 300 linhas e quero criar 300 arquivos distintos. O nome do arquivo de texto 1 deve ser o conteúdo da célula D1. O nome do arquivo de texto 2 deve ser o conteúdo da célula D1, e assim sucessivamente.

Como não sei nomear desta forma, estou nomeando os arquivos .txt como 1, 2, 3,.....etc e depois abro um por um para renomear. Segue abaixo o trecho que pega as linhas 1 e 2 e salva os arquivos 1.txt e 2.txt.

Range("D1:AQ1").Select

Selection.Copy

Workbooks.Add

Range("A1:A40").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _

"F:\ajustes\1.txt", FileFormat:=xlText, _

CreateBackup:=False

ActiveWorkbook.Save

ActiveWindow.Close

Range("D2:AQ2").Select

Selection.Copy

Workbooks.Add

Range("A1:A40").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _

"F:\ajustes\2.txt", FileFormat:=xlText, _

CreateBackup:=False

ActiveWorkbook.Save

ActiveWindow.Close

É muito difícil fazer esta rotina de repetição? É possível me ajudar? Eu até entendo um pouco de programação, mas não sei os nomes das funções do VBA.

Agradeceria muito se pudesse dar uma força.

Atenciosamente,

Ailsom

[Guest João Neto]

Você pode usar o código abaixo:

Sub GenerateTxtFiles()

Range("D1:AQ1").Select

Selection.Copy

Workbooks.Add

Range("A1:A40").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Application.CutCopyMode = False

'AQUI COMEÇAREI A SALVAR OS ARQUIVOS

For i = 1 To Range("A1").CurrentRegion.Rows.Count 'Executo um For até a quantidade total de linhas que possuo

ActiveWorkbook.SaveAs Filename:= _

"F:\ajustes\" & Cells(i, 1) & ".txt", FileFormat:=xlText, _

CreateBackup:=False

Next i

ActiveWorkbook.Save

ActiveWindow.Close

End Sub

:closedeyes:

[Guest --aillsom --]

João,

Obrigado pela ajuda, mas cada linha se transforma em um arquivo distinto. O seu código está pegando apenas a primeira linha e transformando em 40 arquivos de texto com os nomes diferentes.

O comando de copiar e colar transposto não deve ser dentro do loop para que, a cada vez que o i é incrementado, seja copiada a próxima linha? Tentei colocar a linha de comandos no loop e sempre dá erro. COmo faço para vincular a linha que estou copiando à variável "i"?

[João.Neto]

Desculpe, eu não havia entendido plenamente sua necessidade. Segue o código abaixo, favor analisar:

Sub GeraArquivosTXT()

Application.DisplayAlerts = False

Dim wkbName As String

For i = 1 To Range("D1").CurrentRegion.Rows.Count

wkbName = Range("D" & i).Value

Range("D" & i & ":AQ" & i).Copy

Workbooks.Add

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _

"F:\Teste\" & wkbName & ".txt", FileFormat:=xlText, _

CreateBackup:=False

ActiveWorkbook.Save

ActiveWindow.Close

Next

End Sub

:blush:

[Guest --aillsom --]

João,

Era exatamente isso que precisava. Muito obrigado pela ajuda. Abraço e boa sorte.

Aillsom Dias