Создание новой книги для каждой строки в существующей книге

Question

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

Базовая книга структурирована в строках от A до J, где столбец A содержит значение, которое я хочу сохранить в новой книге как. Новая книга должна перенести значения и разбить строку на два столбца (это связано со структурой управляющей программы на машине, а не с тем, что я могу изменить). Первый столбец в новой книге будет содержать значения от В до Н и второй столбец будет содержать значения от I и J.

Для пояснения: строка рабочей книги Base - х хх ххх хххх ххххх ... Х ХХ

Новый формат книги - маленькие иксы бы записи столбцов A и капитал X будет столбец записи в Б.

Я могу сделать выше, и преобразовать строку в двух отдельных столбцов в новой книге , Я также попытался рассмотреть похожие вопросы и ответы для этого, но не смог собрать вместе способ сделать вышеупомянутую работу.

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

Спасибо за любую помощь, которую кто-либо может предоставить.

код из макроса приведен ниже:.

Sub Macro6() 
' 
' Macro6 Macro 
' 
' Keyboard Shortcut: Ctrl+q 
' 
    Workbooks.Add 
    Application.Left = 721 
    Application.Top = 1 
    Application.Width = 720 
    Application.Height = 780 
    Windows("TEST.xlsx").Activate 
    Range("B2:H2").Select 
    Selection.Copy 
    Windows("Book10").Activate 
    Range("A1:A7").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    Range("B1").Select 
    Windows("B9 for Import TEST.xlsx").Activate 
    Range("I2:J2").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Windows("Book10").Activate 
    Range("B1:B2").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    Windows("TEST.xlsx").Activate 
End Sub 

Он будет работать копию над данными один раз, но потом говорит мне, что индекс находится вне диапазона выделяя ~ Окна («Book10») Активировать ~ линия.

Answer 1

Вот что я придумал. Я побежал этот код с помощью кнопки на рабочем листе с данными, выглядит следующим образом:

Вот код прилагается к кнопке 1:

Sub Button1_Click() 

Application.DisplayAlerts = False 
Application.ScreenUpdating = False 

On Error GoTo PROC_ERROR 

Dim ThisWorkbook As Workbook, NewBook As Workbook 
Dim ThisWorksheet As Worksheet, NewWs As Worksheet 
Dim i As Integer, j As Integer, k As Integer, ExportCount As Integer 

Set ThisWorkbook = ActiveWorkbook 
Set ThisWorksheet = ThisWorkbook.Sheets("Sheet1") 
ExportCount = 0 

For i = 1 To 10 
    If ThisWorksheet.Cells(i, 1) <> "" Then 
     Set NewBook = Workbooks.Add 
     Set NewWs = NewBook.Sheets("Sheet1") 
     For j = 2 To 8 
      If ThisWorksheet.Cells(i, j) <> "" Then 
       NewWs.Cells(j - 1, 1) = ThisWorksheet.Cells(i, j) 
      End If 
     Next j 
     For k = 9 To 10 
      If ThisWorksheet.Cells(i, k) <> "" Then 
       NewWs.Cells(k - 8, 2) = ThisWorksheet.Cells(i, k) 
      End If 
     Next k 
     With NewBook 
      .Sheets("Sheet2").Delete 
      .Sheets("Sheet3").Delete 
      .Title = ThisWorksheet.Cells(i, 1) 
      .SaveAs Filename:=ThisWorksheet.Cells(i, 1) & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
     End With 
     ExportCount = ExportCount + 1 
    End If 
Next i 

PROC_ERROR: 
If Err.Number <> 0 Then 
    MsgBox "This macro has encountered an error and needs to exit. However, some or all of your exported workbooks may still have been saved. Please try again." _ 
    & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbInformation 
    ExportCount = 0 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    Exit Sub 
Else 
    MsgBox "Successfully exported " & ExportCount & " workbooks!", vbInformation 
    ExportCount = 0 
End If 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub 

Выход выглядит следующим образом:

Позвольте мне знать, если вы хотите, чтобы я подробно объяснил код!

EDIT: Обновлен код: добавлена ​​обработка Application.ScreenUpdating и правильная обработка ошибок.