Всем привет! не соображу ни как как изменить строку [vba]
Код
Set template = Workbooks.Open(myPath & "\шаблон.xlsm")
[/vba] на [vba]
Код
Dim avFiles avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выберете файл", , True) ' Set template = Workbooks.Open(avFiles)
[/vba] Что бы пользователь сам выбирал нужный файл для копирования.
[vba]
Код
Sub createFiles() Application.ScreenUpdating = False Dim folderName$, myPath$ myPath = ThisWorkbook.Path Set sh = ThisWorkbook.Sheets(1) Set template = Workbooks.Open(myPath & "\шаблон.xlsm")
With sh For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row folderPath = myPath & "\" & .Cells(i, 1) If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath) With template.Sheets(5) .[o53] = sh.Cells(i, 7) End With With template.Sheets(2) .[d7] = sh.Cells(i, 2): .[s7] = sh.Cells(i, 6): .[h9] = sh.Cells(i, 3): .[x9] = sh.Cells(i, 4): .[d11] = sh.Cells(i, 1) template.SaveCopyAs folderPath & "\" & sh.Cells(i, 3) & " " & sh.Cells(i, 2) & ".xlsm" End With Next i End With template.Close False Application.ScreenUpdating = True MsgBox "Готово!" End Sub
[/vba]
Всем спасибо за понимание, голова уже кружится от этих кодов...
Всем привет! не соображу ни как как изменить строку [vba]
Код
Set template = Workbooks.Open(myPath & "\шаблон.xlsm")
[/vba] на [vba]
Код
Dim avFiles avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выберете файл", , True) ' Set template = Workbooks.Open(avFiles)
[/vba] Что бы пользователь сам выбирал нужный файл для копирования.
[vba]
Код
Sub createFiles() Application.ScreenUpdating = False Dim folderName$, myPath$ myPath = ThisWorkbook.Path Set sh = ThisWorkbook.Sheets(1) Set template = Workbooks.Open(myPath & "\шаблон.xlsm")
With sh For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row folderPath = myPath & "\" & .Cells(i, 1) If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath) With template.Sheets(5) .[o53] = sh.Cells(i, 7) End With With template.Sheets(2) .[d7] = sh.Cells(i, 2): .[s7] = sh.Cells(i, 6): .[h9] = sh.Cells(i, 3): .[x9] = sh.Cells(i, 4): .[d11] = sh.Cells(i, 1) template.SaveCopyAs folderPath & "\" & sh.Cells(i, 3) & " " & sh.Cells(i, 2) & ".xlsm" End With Next i End With template.Close False Application.ScreenUpdating = True MsgBox "Готово!" End Sub
[/vba]
Всем спасибо за понимание, голова уже кружится от этих кодов...Sancho
Сообщение отредактировал Sancho - Среда, 01.06.2016, 10:58