Здравствуйте, подскажите пожалуйста новичку в работе с макросами, как можно решить данную проблему. К сожалению не смогла найти решение подобной задачи в интернете.
Для более подробного объяснения: Есть вот такие 2 столбца на первом листе с видами растений и их порядковыми номерами, количество строчек может быть разное. Название каждого листа в таблице, кроме первого - порядковый номер (в моей таблице названия листов изменяются с помощью макроса).
1
Вишня
2
Яблоня
3
Роза
4
Тюльпан
5
Камыш
Как с помощью цикла можно скопировать значения из столбца с названиями последовательно по одному на уже существующие листы с формулами и данными? На листе "1" в A1 должно быть "Вишня", на листе "2" в A1 должно быть " Яблоня" и так далее. Количество строчек, соответственно и листов, каждый раз разное, поэтому желательно чтобы заполнение ячеек на листах шло до первого пустого места в столбце В на первом листе.
Sub Slect_range()
lastColumn = Sheets(1).Cells(1, 100).End(xlToLeft).Column
lastRow = Sheets(1).Cells(1000, 1).End(xlUp).Row
Call Add_sheets(lastColumn, lastRow)
End Sub
Sub Add_sheets(col, rows)
For mRow = 1 To rows
sheet_name = Sheets("Лист1").Cells(mRow, col).Value
sheet_name = Str(mRow) & "_" & sheet_name
On Error Resume Next
cheker = Sheets(sheet_name).Name
If cheker = sheet_name Then
GoTo next_row
Else
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
Sheets(sheet_name).Cells(1, 1).Value = sheet_name
End If
next_row:
Next mRow
End Sub
Спасибо за ответ, но я забыла дописать в задачу: мне не нужно создавать пустые новые листы, у меня на каждом листе, кроме первого есть формулы и ссылки на предыдущие листы. Можно ли как-то изменить ваш макрос, чтобы вставлялось в уже существующие листы?
Sub Raznesti()
Dim i As Long
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iLastRow
With Worksheets(CStr(Cells(i, 1)))
.Range("A1") = Cells(i, "B")
End With
Next
End Sub
Sub Slect_range()
lastColumn = Sheets(1).Cells(1, 100).End(xlToLeft).Column
lastRow = Sheets(1).Cells(1000, 1).End(xlUp).Row
Call Add_sheets(lastColumn, lastRow)
End Sub
Sub Add_sheets(col, rows)
For mRow = 1 To rows
cell_value = Sheets("Лист1").Cells(mRow, col).Value
sheet_name = Str(mRow) & "_" & cell_value
On Error Resume Next
cheker = Sheets(sheet_name).Name
If cheker = sheet_name Then
Sheets(sheet_name).Cells(1, 1).Value = cell_value
GoTo next_row
Else
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
Sheets(sheet_name).Cells(1, 1).Value = cell_value
End If
next_row:
Next mRow
End Sub
Если лист с именем "Номер_Название" есть, то в "А1" добавляется содержимое с Листа1. Если листа с именем "Номер_Название" нет, то создается такой лист и в "А1" добавляется содержимое с Листа1.