Сохранения каждой строчки в отдельный файл

[arudo]

Здравствуйте! Есть задача сохранить каждую строчку в отдельный файл тхт, вроде нашел решение, но необходимо как то его доработать

Sub artlayers()
Dim c As Range, d As Range
For Each c In ActiveSheet.UsedRange.Columns(1).Sp ecialCells(xlCellTypeConstants)
Open ThisWorkbook.Path & "\" & c & ".html" For Output As #1
For Each d In Range(c, Cells(c.Row, Columns.Count).End(xlToLeft))
Print #1, d
Next
Close #1
Next
End Sub

все отлично сохраняет, но берет имя из первого столбца, а мне необходимо имя брать из одного столбца, а в файл заносить остальные. т.е. ячейки с именем файла в теле файла быть не должно.
еще было бы не плохо, если бы в тхт файле все данные были в одну строчку, без переносов.

Заранее благодарен за подсказки.

[IgorGO]

правильно сформулированный вопрос - это залог точного ответа.

Вам нужны подсказки или Вам нужен работающий код?

а вот и подсказка:
пройдитесь по ячейкам столбца, обьедините все в одну строку, записывайте в файл эту строку, а не каждую ячейку по отдельности.

удачи!

[arudo]

скорее работающий код, или конкретное предложение по доработке существующего

[Aleksandr H.]

набросок

Sub artlayers()
Dim c As Range, d As Range, s as string
For Each c In ActiveSheet.UsedRange.Columns(1).Sp ecialCells(xlCellTypeConstants)
Open ThisWorkbook.Path & "\" & c & ".html" For Output As #1
s = ""
For Each d In Range(c.offset(0,1), Cells(c.Row, Columns.Count).End(xlToLeft))
s = s & d
next
Print #1, s

Close #1
Next
End Sub

[arudo]

набросок оказался вполне рабочим кодом, скажите как вас отблагодарить?

[IgorGO]

Sub Data2TxtFiles()
  Dim r&
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Open ThisWorkbook.Path & "\" & c & ".html" For Output As #1
    With WorksheetFunction
      If .CountA(Rows(r)) = 2 Then Print #1, "" & Cells(r, 2) Else Print #1, Join(.Transpose(.Transpose(Cells(r, 2).Resize(1, .CountA(Rows(r)) - 1))), "")
    End With
    Close #1
  Next
End Sub

или уменьшим количество строк в макросе

Sub Data2TxtFiles()
  Dim r&
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Open ThisWorkbook.Path & "\" & c & ".html" For Output As #1
    If WorksheetFunction.CountA(Rows(r)) = 2 Then Print #1, "" & Cells(r, 2) Else Print #1, Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Cells(r, 2).Resize(1, WorksheetFunction.CountA(Rows(r)) - 1))), "")
    Close #1
  Next
End Sub