#excel #vba
Вопрос:
Я успешно смог взять ряд ячеек и создать рабочие листы по имеющемуся у меня шаблону. Я планирую использовать свой шаблон для копирования и вставки имеющихся у меня рабочих элементов.
В моем коде мне также нужно скопировать и вставить определенную строку в новые рабочие листы, которые она уже создала.
Вот мой код…
Sub CreateSheets() Dim rng As Range Dim cell As Range On Error GoTo Errorhandling Set rng = Application.InputBox(Prompt:="Select cell range:", _ Title:="Create sheets", _ Default:=Selection.Address, Type:=8) For Each cell In rng 'Check if cell is not empty If cell lt;gt; "" Then 'Insert worksheet and name the worksheet based on cell value Sheets("Template").Copy After:=Sheets("Unit Types") 'Name new sheet based off two cells on Bid Summary List Cells (Bi and Di) ActiveSheet.Name = "UNIT-" amp; cell 'This is where I think I should add the copy/paste lines... but I don't know how. 'Copy unit# row and paste in correct worksheet Range("XX:XX").Copy Range("XX:XX") End If 'Continue with next cell in cell range Next cell 'Go here if an error occurs Errorhandling: 'Stop macro End Sub На фотографиях я показал, куда я хотел бы вставить информацию. Таким образом, я могу связать ячейки с соответствующими областями в шаблоне… и просто запустить vba, чтобы удалить пустые ячейки.
введите описание изображения здесь введите описание изображения здесь
Комментарии:
1. Добро пожаловать в SO! Кажется, что вам ясно, что вы намерены делать, но это не так ясно, как вопрос. Для того, чтобы было понятно, вы должны показать информацию: как работает шаблон, как осуществляется ввод, каков ожидаемый результат. С тем, который вы прикрепили, кажется, что нужно вставить по адресу ячейки (строка и столбец). Есть некоторые предположения, которые вам следует лучше объяснить, каков из них ввод в поле ввода, который вы намереваетесь сделать, чтобы ваш код работал.
Ответ №1:
Попробуй это:
Sub CreateSheets() Dim rng As Range, wsUnitTypes as Worksheet Dim cell As Range, ws As Worksheet, wb As Workbook 'On Error GoTo Errorhandling 'uncomment this when your code is working... Set wb = ActiveWorkbook Set wsUnitTypes = wb.Sheets("Unit Types") Set rng = Application.InputBox(Prompt:="Select cell range:", _ Title:="Create sheets", _ Default:=Selection.Address, Type:=8) For Each cell In rng.Cells 'loop selected unit#'s If Len(cell.Value) gt; 0 Then 'check if cell is not empty wb.Sheets("Template").Copy After:= wsUnitTypes Set ws = wb.Sheets(wsUnitTypes.Index 1) 'reference the new sheet ws.Name = "UNIT-" amp; cell.Value 'copy (e.g.) 1x10 range starting at `cell` cell.Resize(1, 10).Copy ws.Range("E5") End If Next cell Exit Sub 'don't run into the error handler Errorhandling: End Sub Комментарии:
1. Нет, это не работает для меня. Он больше не создает новые рабочие листы. Я пытаюсь адаптировать то, что у вас есть, к моему коду, чтобы посмотреть, не произойдет ли что-нибудь.
2. Прокомментируйте обработчик ошибок и посмотрите, что вы получите