Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/копирование имени листа в каждую непустую строку - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование имени листа в каждую непустую строку (Макросы/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
 
Ответить
СообщениеДобрый вечер, форумчане.
Подскажите пожалуйста, как преобразовать код
[vba]
Код
Sub ààà()
  Range("B8") = ActiveSheet.Name
  Range("B9") = ActiveSheet.Name
End Sub
[/vba]
чтобы в каждой непустой строке в определенном столбце (пусть это будет столбец B ) копировалось имя активного листа?
Строк может быть много, и каждый раз разное количество.
Спасибо.

Автор - miha_
Дата добавления - 30.07.2019 в 23:23
krosav4ig Дата: Вторник, 30.07.2019, 23:51 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 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
 
Ответить
СообщениеДобрый вечер
[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]

Автор - krosav4ig
Дата добавления - 30.07.2019 в 23:51
wild_pig Дата: Вторник, 30.07.2019, 23:53 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 517
Репутация: 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]
 
Ответить
Сообщение[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]

Автор - wild_pig
Дата добавления - 30.07.2019 в 23:53
miha_ Дата: Вторник, 30.07.2019, 23:55 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, добрый вечер. Спасибо.
 
Ответить
Сообщениеkrosav4ig, добрый вечер. Спасибо.

Автор - miha_
Дата добавления - 30.07.2019 в 23:55
miha_ Дата: Вторник, 30.07.2019, 23:56 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
wild_pig, спасибо
 
Ответить
Сообщениеwild_pig, спасибо

Автор - miha_
Дата добавления - 30.07.2019 в 23:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование имени листа в каждую непустую строку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!