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

Вход

Регистрация

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

 

= Мир MS Excel/Создать листы из списка (через выделение ячеек). - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Создать листы из списка (через выделение ячеек).
Mark1976 Дата: Воскресенье, 25.02.2024, 11:07 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Здравствуйте. Необходимо поправить код, чтобы листы создавались не из прописанного диапазона в макросе, а путем выделения нужных ячеек.
[vba]
Код
Sub AddSheets()
'Updateby Extendoffice
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал Mark1976 - Воскресенье, 25.02.2024, 11:08
 
Ответить
СообщениеЗдравствуйте. Необходимо поправить код, чтобы листы создавались не из прописанного диапазона в макросе, а путем выделения нужных ячеек.
[vba]
Код
Sub AddSheets()
'Updateby Extendoffice
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Mark1976
Дата добавления - 25.02.2024 в 11:07
Апострофф Дата: Воскресенье, 25.02.2024, 11:11 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
Mark1976, поменяйте
wSh.Range("A1:A7")
на
SELECTION
или на
Application.InputBox(prompt:="Укажите диапазон ячеек:", Type:=8)


Сообщение отредактировал Апострофф - Воскресенье, 25.02.2024, 11:22
 
Ответить
СообщениеMark1976, поменяйте
wSh.Range("A1:A7")
на
SELECTION
или на
Application.InputBox(prompt:="Укажите диапазон ячеек:", Type:=8)

Автор - Апострофф
Дата добавления - 25.02.2024 в 11:11
Mark1976 Дата: Воскресенье, 25.02.2024, 11:21 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Апострофф, спасибо.
 
Ответить
СообщениеАпострофф, спасибо.

Автор - Mark1976
Дата добавления - 25.02.2024 в 11:21
  • Страница 1 из 1
  • 1
Поиск:

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