Экспортировать каждую строку из Excel в собственный документ Word

Это будет довольно специфично.

У меня есть листы с именами пациентов и информацией в каждой строке. Первая строка имеет метки для каждого столбца. Например, столбец a – имя пациента. Im пытается экспортировать каждую строку как свой собственный документ слова, каждая ячейка в строке имеет свою собственную строку с пробелом / разрывом между ними. Но я также хочу, чтобы метка из строки 1 была с каждой конкретной строкой. Также сделайте первый столбец aka PatientName именем для каждого документа.

Ex.

Название документа: John Doe

Дата встречи
11-12-13

CC
Боль в животе

HPI
Г-н Доу – это бла-бла, и куча текста

\ Ex

Строка # 1 выглядит так: PatientName / EncounterDate / CC / HPI

Строка № 2, на которой мы хотим начать, выглядит следующим образом: Джон Доу / 11-12-13 / Боль в животе / г-н. Doe blah blah

Каждая строка содержит 27 ячеек

Спасибо, и дайте мне знать, если вам нужно больше информации. Код VBA.

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

Sub SaveRowsAsCSV() Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet Dim r As Long, c As Long Set wsSource = ThisWorkbook.Worksheets("AmazingChartsEncounters") Application.DisplayAlerts = False 'will overwrite existing files without asking r = 1 Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0 ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1) Set wsTemp = ThisWorkbook.Worksheets(1) For c = 2 To 27 'I didn't test it when I changed the 7 here to 27 wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value Next c wsTemp.Move Set wbNew = ActiveWorkbook Set wsTemp = wbNew.Worksheets(1) 'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way wbNew.SaveAs "textfile" & r & ".csv", xlCSV 'new way 'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx wbNew.Close ThisWorkbook.Activate r = r + 1 Loop Application.DisplayAlerts = True End Sub