Страницы: 1
RSS
Переименовать листы макросом, VBA
 
Здравствуйте! Есть файл Consolid.xlsm в который макросом загружаю листы из других файлов (пример: WAS.xlsx). Как сделать так, что бы при загрузке листы переименовывались по принципу "Название файла_оригинальное название листа" (пример: WAS_Arkusz1), а пустые листы - не загружались? Заранее благодарен.
 
что то подобное пробовали?

workbook(1),sheet(2).name = workbook(1).name & workbook(1).worksheets.count
не нужно оскорблять.
 
Цитата
Александр Сергеевич написал:
workbook(1),sheet(2).name
почему workbook(1),sheet(2), а не sheet(1) ?
 
вот у меня работает добавил строку Sheets(1).Name = Sheets().Parent.Name
но это только на первый лист файла донора
Код
'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
      Sheets(1).Name = Sheets().Parent.Name
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        
        importWB.Close savechanges:=False
        x = x + 1
        
    Wend
не нужно оскорблять.
 
Цитата
Romuald написал:
почему workbook(1),sheet(2), а не sheet(1) ?
очень часто нужно определять какой книги , т.к. без этого параметра береться активная книга, а в коде она может меняться,  если возможно лучше указывать.
не нужно оскорблять.
 
Александр Сергеевич, спасибо, направление понял, буду копать... Не понятно только как игнорировать пустые листы...
 
Romuald,
ну это уже через циклы (фор например), если на листе есть данные то копировать.....
имена также можно присваивать

но помойму у Вас копируются все листы разом, так может удалять пустые листы а потом копировать... книга закрывается без сохранения....
не нужно оскорблять.
 
Цитата
Romuald написал: как игнорировать пустые листы
Код
Sub jjj_empty_sheet_ignore()
Dim rng As Range

    Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
    If IsEmpty(rng) And _
        rng.Row = 1 And rng.Column = 1 Then
        MsgBox "Лист пустой"
    Else
        MsgBox "Лист НЕ пустой"
    End If
End Sub
Изменено: JayBhagavan - 09.03.2016 18:26:28

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Цитата
Александр Сергеевич написал:
может удалять пустые листы а потом копировать... книга закрывается без сохранения....
Так и сделаю.
 
Макрос исправил.
---
Или так:
Код
Sub jjj_empty_sheet_ignore2()
    If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 0 Then
        MsgBox "Лист пустой"
    Else
        MsgBox "Лист НЕ пустой"
    End If
End Sub
Изменено: JayBhagavan - 09.03.2016 19:06:19

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
JayBhagavan, а что по-Вашему должна вернуть строка: ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)?
Что по мне - то только одну последнюю ячейку. А т.к. SpecialCells может вернуть и пустую ячейку - то это не очень верный ход. Куда правильнее проверять наличие данных на листе так:
Код
If ActiveSheet.usedrange.text = "" then
msgbox "лист пуст"
end if
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, спасибо за Ваше уточнение. Не претендую на истинность решения. Это были мысли вслух. :) А со вторым макросом стратил. Исправляю...

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Спасибо всем, кто помогал. Вот что в итоге получилось, только макрос немного долго отрабатывает:

Код
Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
 
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
     
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
    
        For i = 1 To importWB.Sheets.Count
            If Not (WorksheetFunction.CountA(importWB.Sheets(i).UsedRange) = 0) Then
                importWB.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
               
 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = 
Left(importWB.Name, InStr(importWB.Name, ".") - 1) + "_" + 
importWB.Sheets(i).Name
            End If
        Next i
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub
Изменено: Romuald - 10.03.2016 11:01:13
 
У названий листов есть ограничения по количеству символов. Ну и по конкретно названиям, но это думаю тут не актуально, а вот на количество можете попасть.
 
ъ
Изменено: LOSHADKA - 03.02.2024 15:56:28
Страницы: 1
Наверх