День добрый. помогите пожалуйста - пересмотрел все топики, но не нашёл ... Такая проблема: Имеется исходный файл "Данные" с данными (ФИО, дата рождения, номер паспорта и прочее) Необходимо: переместить эти данные в формализированный бланк формы Т-2 для каждого человека, но на каждого человека необходимо создавать свой отельный экселевский файл, в идеале -название файла это имя человека.
Перелопатил много, но найти не удалось.
Интуитивно догадываюсь, что как-то через макрос, но в них не бум-бум. Фамилий более 500, вручную совсем не вариант
День добрый. помогите пожалуйста - пересмотрел все топики, но не нашёл ... Такая проблема: Имеется исходный файл "Данные" с данными (ФИО, дата рождения, номер паспорта и прочее) Необходимо: переместить эти данные в формализированный бланк формы Т-2 для каждого человека, но на каждого человека необходимо создавать свой отельный экселевский файл, в идеале -название файла это имя человека.
Перелопатил много, но найти не удалось.
Интуитивно догадываюсь, что как-то через макрос, но в них не бум-бум. Фамилий более 500, вручную совсем не вариантraido1979
Мой вариант, возможно, не самый оптимальный... [vba]
Код
Public Sub FormT2() Dim Path$, i&, x Path = ThisWorkbook.Path & "\FormT2.xlt" 'путь к шаблону If Dir(Path) = "" Then Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False x = ThisWorkbook.Sheets("Лист1").Range("A1").CurrentRegion.Value For i = 2 To UBound(x) Workbooks.Open (Path) With ActiveWorkbook With .Sheets("Лист1") .Range("H26") = x(i, 1) .Range("AB26") = x(i, 2) .Range("AW26") = x(i, 3) .Range("K29") = x(i, 4) .Range("V16") = x(i, 8) .Range("L16") = x(i, 9) .Range("H16") = x(i, 10) End With With .Sheets("Лист2") .Range("K24") = x(i, 5) .Range("H25") = x(i, 6) .Range("T31") = x(i, 11) End With .SaveAs (ThisWorkbook.Path & "\" & .Sheets("Лист1").Range("H26")) .Close True End With Next i Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Готово!" End Sub
[/vba]
Мой вариант, возможно, не самый оптимальный... [vba]
Код
Public Sub FormT2() Dim Path$, i&, x Path = ThisWorkbook.Path & "\FormT2.xlt" 'путь к шаблону If Dir(Path) = "" Then Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False x = ThisWorkbook.Sheets("Лист1").Range("A1").CurrentRegion.Value For i = 2 To UBound(x) Workbooks.Open (Path) With ActiveWorkbook With .Sheets("Лист1") .Range("H26") = x(i, 1) .Range("AB26") = x(i, 2) .Range("AW26") = x(i, 3) .Range("K29") = x(i, 4) .Range("V16") = x(i, 8) .Range("L16") = x(i, 9) .Range("H16") = x(i, 10) End With With .Sheets("Лист2") .Range("K24") = x(i, 5) .Range("H25") = x(i, 6) .Range("T31") = x(i, 11) End With .SaveAs (ThisWorkbook.Path & "\" & .Sheets("Лист1").Range("H26")) .Close True End With Next i Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Готово!" End Sub