копирование имени листа в каждую непустую строку

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

копирование имени листа в каждую непустую строку (Макросы/Sub)

miha_

Дата: Вторник, 30.07.2019, 23:23 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 87

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Добрый вечер, форумчане.
Подскажите пожалуйста, как преобразовать код
[vba]

Код

Sub ààà()
Range("B8") = ActiveSheet.Name
Range("B9") = ActiveSheet.Name
End Sub

[/vba]
чтобы в каждой непустой строке в определенном столбце (пусть это будет столбец B ) копировалось имя активного листа?
Строк может быть много, и каждый раз разное количество.
Спасибо.

К сообщению приложен файл: 8305662.xlsm (21.0 Kb)

Сообщение отредактировал miha_ - Вторник, 30.07.2019, 23:24

Ответить

krosav4ig

Дата: Вторник, 30.07.2019, 23:51 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Добрый вечер
[vba]

Код

Sub sdf()
    Dim v As Variant, ar As Range
    On Error Resume Next
    With ActiveSheet.UsedRange
        With Intersect(.Offset(4 - .Row), .Cells)
            For Each v In Array(xlCellTypeFormulas, xlCellTypeConstants)
                For Each ar In .SpecialCells(v, 23).EntireRow.Areas
                    Intersect(ar, .Parent.[B:B]).Value = .Parent.Name
            Next ar, v
        End With
    End With
End Sub

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 30.07.2019, 23:52

Ответить

wild_pig

Дата: Вторник, 30.07.2019, 23:53 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 518

Репутация: 97 ±

Замечаний: 0% ±

2003, 2013

[vba]

Код

Sub ааа()
  Dim i&
'----------
    With ActiveSheet
        For i = 8 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 2) = "" Then .Cells(i, 2) = .Name
        Next
    End With
End Sub

[/vba]