Макрос импорта Ексель файлов из папки в листы одной книги с последующим выполнения макросов.СПБ.

[SAS888]

Макрос, удаляющий строки активного листа, в которых есть хотя бы 1 пустая ячейка:

Sub DelRows()
    Application.ScreenUpdating = False: On Error Resume Next
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

[as-is]

""А зачем иметь кучу листов, да еще и с кучей макросов? Не проще ли иметь один макрос, который запускается по событию книги Workbook_NewSheet(ByVal Sh As Object). Т.е. при каждом добавлении нового листа.""
Спасибо за ""Workbook_NewSheet(ByVal Sh As Object)"". Если бы я знал, как это приспособить.
---------------------------------------------------------------------
***здесь позволю себе пофилософствовать - я выбрал себе путь обучения через форум, - получаю ответы и пробую хоть что-то понять в структуре макросов. Иногда получается. Написать свои макросы - пока не способен. Поэтому не устану говорить спасибо за ответы.
---------------------------------------------------------------------
Много листов определяется количеством файлов, которые необходимо обработать и мне проще не смешивать их. Внутри каждого тысячи строк, например. Тогда я уж точно запутаюсь. Моя логика примитивна - каждый день я автоматически измеряю или получаю или прочее 10-20 файлов (беру с большим запасом). Загоняю их в одну книгу, обрабатываю, сохраняю = каждый непустой день всего один объединённый файл.
Насчет того, что много макросов, то их всего:
1. макрос открытия вставки-комбинирования = один;
2. макрос удаления ненужных строк = один;
3. макрос сравнения колонок, диаграмм и прочее -сейчас не принципиально;
4. сохранение-вывод на печать = один -сейчас не принципиально

[as-is]

ВОПРОС. Уважаемый SAS888, спасибо за код. Почти разобрался. Еще один мой глупый вопрос: как сделать, чтобы код
-----------------------------------------------
Sub DelRows()
Application.ScreenUpdating = False: On Error Resume Next
ActiveSheet.UsedRange.SpecialCells( xlCellTypeBlanks).EntireRow.Delete
End Sub
-------------------------------------------------
удалял строку при условии пустой ячейки, но при этом в некоторых других ячейках этой строки есть текст и численные значения (формально любого формата).
Указанный Вами код удаляет, но не в моем случае ("текст в ячейке").
Создаю новую книгу, вставляю все, что можно = все работает.
Где я ошибаюсь. Может проблема в том, что листы именованы.

[SAS888]

чтобы код удалял строку при условии пустой ячейки, но при этом в некоторых других ячейках этой строки есть текст и численные значения (формально любого формата).

Не понял. Объясните по-медленнее. Лучше с примером.

[as-is]

Сам не понимаю. Беру свой созданный файл - все работает; беру чужой - ничего. Макрос чувствителен к защите файла (глупость наверное).
Из файла, в котором не получается добиться результата копирую данные и вставляю в новый файл - снова все ОК. Мистика.

[SAS888]

Ваша задача немного сложнее, чем кажется. Т.к. Вам требуется

я удаляю не только пустые строки, но и строки в которых есть хотя бы одна пустая ячейка

то сложность в том, где границы контролируемого диапазона. Т.к. в приложенном Вами файле есть пустые ячейки, содержащие формат, то определение рабочего диапазона как с помощью UsedRange, так и с помощью SpecialCells(xlCellTypeLastCell) приведет к ошибочному результату. Т.е. если мы, например, будем рассматривать диапазон, содержащий пустой (лишний) столбец, то все строки будут удалены (ведь по условию, раз в каждой строке есть хотя бы одна пустая ячейка - то строка удаляется).
Поэтому, сначала нужно определить последний заполненный столбец, а уже затем проверять на пустоту строку от 1-го до определенного нами столбца. Т.е. без цикла не обойтись. Постаравшись организовать наиболее оптимальный (минимальный) цикл, у меня получился следующий код:

Sub DelRows()
    Dim i As Long: Application.ScreenUpdating = False
    For i = Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
        If Columns(i).Text = "" Then Else Exit For
    Next
    Range([A1], Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, i)) _
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Пример файла во вложении.

[as-is]

Спасибо за науку и прилагаемый файл.

[skapitan]

есть макрос который собирает несколько листов из разных файлов в одну книгу. почему-то иногда собирает все файлы, а иногда только первый.

помогите, пожалуйста, чтобы собирал не только XLS, но и CSV + XLXM etc

Sub CombineWorkbooks()
'ctrl+shift+W
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "no files selected"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

_____
Код программы нужно выделять (форматировать) тегами [CODE] [/CODE] (читать FAQ)
Модератор