Ошибка в макросе

[eemil]

Здравствуйте. Не пойму в чем проблема. В книге есть таблица и шаблон. Ячейки в шаблоне заполняются данными из таблицы. Для каждой строки должен формироваться отдельный лист.

Sub my1()
Dim r
Dim wb As Workbook
Set wb = ThisWorkbook
For r = 2 To wb.Sheets("FT").Cells(Rows.Count, 1).End(xlUp).Row
wb.Sheets("Шаблон").Copy after:=wb.Sheets(wb.Sheets.Count)
With wb.Sheets(wb.Sheets.Count)
.Name = Left(wb.Sheets("FT").Cells(r, 1), 31)
.Range("C15") = wb.Sheets("FT").Cells(r, 1)
.Range("D15") = wb.Sheets("FT").Cells(r, 23)
.Range("G15") = wb.Sheets("FT").Cells(r, 3)
.Range("H15") = wb.Sheets("FT").Cells(r, 4)
.Range("H16") = wb.Sheets("FT").Cells(r, 5)
.Range("H17") = wb.Sheets("FT").Cells(r, 6)
.Range("H18") = wb.Sheets("FT").Cells(r, 7)
.Range("I15") = wb.Sheets("FT").Cells(r, 8)
.Range("I16") = wb.Sheets("FT").Cells(r, 9)
.Range("I17") = wb.Sheets("FT").Cells(r, 10)
.Range("I18") = wb.Sheets("FT").Cells(r, 11)
.Range("J16") = wb.Sheets("FT").Cells(r, 16)
.Range("K16") = wb.Sheets("FT").Cells(r, 17)
.Range("L15") = wb.Sheets("FT").Cells(r, 12)
.Range("L16") = wb.Sheets("FT").Cells(r, 13)
.Range("L17") = wb.Sheets("FT").Cells(r, 14)
.Range("L18") = wb.Sheets("FT").Cells(r, 15)
.Range("G26") = wb.Sheets("FT").Cells(r, 27)
End With
Next r
MsgBox "Готово"
End Sub

И еще вопрос, как сделать чтобы эти листы создавались в отдельной книге и при этом данные не просто копировались из ячейки в ячейку, а осуществлялась связь?
Ссылка на саму книгу.
http://file.karelia.ru/wg65gt/

[Казанский]

Пробуйте

Sub my1()
    Dim r As Long
    Dim wb As Workbook, wb1 As Workbook, sFT As Worksheet
    Set wb = ThisWorkbook
    Set sFT = wb.Sheets("FT")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo erHdl
    For r = 3 To sFT.Cells(sFT.Rows.Count, 1).End(xlUp).Row
        wb.Sheets("Шаблон").Copy after:=wb1.Sheets(wb1.Sheets.Count)
shRdy:  With wb1.Sheets(wb1.Sheets.Count)
            .Name = Left(sFT.Cells(r, 1), 31)
            .Range("C15").Formula = "=" & sFT.Cells(r, 1).Address(external:=True)
            .Range("D15").Formula = "=" & sFT.Cells(r, 23).Address(external:=True)
            .Range("G15").Formula = "=" & sFT.Cells(r, 3).Address(external:=True)
            .Range("H15").Formula = "=" & sFT.Cells(r, 4).Address(external:=True)
            .Range("H16").Formula = "=" & sFT.Cells(r, 5).Address(external:=True)
            .Range("H17").Formula = "=" & sFT.Cells(r, 6).Address(external:=True)
            .Range("H18").Formula = "=" & sFT.Cells(r, 7).Address(external:=True)
            .Range("I15").Formula = "=" & sFT.Cells(r, 8).Address(external:=True)
            .Range("I16").Formula = "=" & sFT.Cells(r, 9).Address(external:=True)
            .Range("I17").Formula = "=" & sFT.Cells(r, 10).Address(external:=True)
            .Range("I18").Formula = "=" & sFT.Cells(r, 11).Address(external:=True)
            .Range("J16").Formula = "=" & sFT.Cells(r, 16).Address(external:=True)
            .Range("K16").Formula = "=" & sFT.Cells(r, 17).Address(external:=True)
            .Range("L15").Formula = "=" & sFT.Cells(r, 12).Address(external:=True)
            .Range("L16").Formula = "=" & sFT.Cells(r, 13).Address(external:=True)
            .Range("L17").Formula = "=" & sFT.Cells(r, 14).Address(external:=True)
            .Range("L18").Formula = "=" & sFT.Cells(r, 15).Address(external:=True)
            .Range("G26").Formula = "=" & sFT.Cells(r, 27).Address(external:=True)
        End With
    Next r
MsgBox "Готово"
GoTo fin

erHdl:
  If Err.Number = 91 Then 'Object variable or With block variable not set
    wb.Sheets("Шаблон").Copy
    Set wb1 = ActiveWorkbook
    Resume shRdy
  End If
  MsgBox "Непредвиденная ошибка " & Err.Number & vbLf & Err.Description, vbCritical

fin:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

[eemil]

Спасибо вам. Макрос во вложенном файле работает отлично, но вот тот код который с привязкой, он отображает в ячейках только формулу (=[tabl2.xlsm]FT!$C$50). Пробовал изменять связь во вкладке "Данные", обновлял связь, но не помогло. И еще вопрос ) в шаблон нужно вписать еще и вторую строку, то есть один лист будет содержать данные из двух строк и так далее. Как это реализовать?

[Казанский]

Чтобы формула работала, формат ячейки при вставке формулы не должен быть Текстовый. В файле я поменял формат у желтых ячеек на Общий.

[eemil]

Да, все верно. Спасибо. Вопрос "как вставить вторую строку в лист шаблона" остается открытым )

[IgorGO]

так же как остался открытым вопрос а

вторую строку

- это какую?
и не менее открытый вопрос, а куда вставлять данные с второй строки (после того как определимся где она находится)?

[Aleksandr H.]

Сообщение от eemil

Да, все верно. Спасибо. Вопрос "как вставить вторую строку в лист шаблона" остается открытым )

Если придраться к словам, то это не уже не шаблон если в него добавлять 2 строку. Может сразу в шаблон вставить пустую вторую строку а уже в шаблонокопию импортировать данные?

[eemil]

Выкладываю книгу в которой первый лист это общая таблица, а второй шаблон. Макрос работает таким образом, копирует из общей таблицы конкретные ячейки ОДНОЙ строки в конкретные ячейки шаблона (в книге эти ячейки выделены желтым цветом). Нужно чтобы в этот же шаблон копировались еще и ячейки со второй строки, из тех же столбцов (то есть так же как и первая строка). Только место вставки этих ячеек в шаблоне выделено зеленым цветом (суть такая же как и для первой строки).

[eemil]

Точнее будет - из общей таблицы третью строку я обозвал как "первая", соответственно четвертую как "вторая"

[IgorGO]

из общей таблицы третью строку я обозвал как "первая", соответственно четвертую как "вторая"

вот об этом и речь!
об этом и был вопрос "а кто это такой 2-я строка?"
в том же сообщении был сформулирован след.вопрос? а куда складывать данные из нее???????