Страницы: 1
RSS
VBA. Перенос значений в столбце из первого листа по одной ячейке на новые листы.
 
 Здравствуйте, подскажите пожалуйста новичку в работе с макросами, как можно решить данную проблему. К сожалению не смогла найти решение подобной задачи в интернете.

Для более подробного объяснения:
Есть вот такие 2 столбца на первом листе с видами растений и их порядковыми номерами, количество строчек может быть разное. Название каждого листа в таблице, кроме первого - порядковый номер (в моей таблице названия листов изменяются с помощью макроса).
1 Вишня
2 Яблоня
3 Роза
4 Тюльпан
5 Камыш
Как с помощью цикла можно скопировать значения из столбца с названиями последовательно по одному на уже существующие листы с формулами и данными? На листе "1" в A1 должно быть "Вишня", на листе "2"  в A1 должно быть " Яблоня" и так далее. Количество строчек, соответственно и листов, каждый раз разное, поэтому желательно чтобы заполнение ячеек на листах шло до первого пустого места в столбце В на первом листе.

Заранее спасибо за любые советы.
Изменено: Ana Lin - 17.07.2020 10:35:25
 
Код
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
 


Изменено: PDO - 17.07.2020 02:25:54 (^_^)
 
Спасибо за ответ, но я забыла дописать в задачу: мне не нужно создавать пустые новые листы, у меня на каждом листе, кроме первого есть формулы и ссылки на предыдущие листы. Можно ли как-то изменить ваш макрос, чтобы вставлялось в уже существующие листы?
 
Цитата
чтобы вставлялось в уже существующие листы?
Код
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.
Изменено: PDO - 17.07.2020 13:09:36
Страницы: 1
Наверх