Добрый день! Есть одна книга excel, в которую будут собираться ежедневные суточные рапорты, каждый из которых представляет из себя отдельный лист excel. Нужен макрос, который будет подтягивать поступающие рапорты. Имя каждого нового листа - "15 -СБМ суточный рапорт". В каждом последующем рапорте в имени меняться будет только цифра, типа: 15, 16, 17, 18 и т.д. Основная книга имеет название "Анализ по БР" (файлы примеры во вложении) Основная книга и поступающие рапорты хранятся строго в одной попке Если это технически возможно, прошу вас помочь!
[vba]
Код
Private Sub Test() Dim iPath$, iFileName$ iPath = ThisWorkbook.Path & "" iFileName = Dir(iPath & "15 -СБМ суточный рапорт.xls")
Application.ScreenUpdating = False Do Until iFileName = "" If iFileName <> ThisWorkbook.Name Then ThisWorkbook.Sheets.Add , , , iPath & iFileName End If iFileName = Dir Loop Application.ScreenUpdating = True End Sub
[/vba]
Есть такой код, который частично выполняет задачу. НО: 1) приходится менять имя файла, чтобы он тянул нужный.. можно что-то сделать, чтобы макрос просто тянул каждый новый лист из папки ежесуточно? 2) Подтянутый лист вставляется в начало книги.. Как сделать так, чтобы лист вставлялся в конец? Max_Nesterov на форуме Обратить внимание администрации на это сообщение 0
Добрый день! Есть одна книга excel, в которую будут собираться ежедневные суточные рапорты, каждый из которых представляет из себя отдельный лист excel. Нужен макрос, который будет подтягивать поступающие рапорты. Имя каждого нового листа - "15 -СБМ суточный рапорт". В каждом последующем рапорте в имени меняться будет только цифра, типа: 15, 16, 17, 18 и т.д. Основная книга имеет название "Анализ по БР" (файлы примеры во вложении) Основная книга и поступающие рапорты хранятся строго в одной попке Если это технически возможно, прошу вас помочь!
[vba]
Код
Private Sub Test() Dim iPath$, iFileName$ iPath = ThisWorkbook.Path & "" iFileName = Dir(iPath & "15 -СБМ суточный рапорт.xls")
Application.ScreenUpdating = False Do Until iFileName = "" If iFileName <> ThisWorkbook.Name Then ThisWorkbook.Sheets.Add , , , iPath & iFileName End If iFileName = Dir Loop Application.ScreenUpdating = True End Sub
[/vba]
Есть такой код, который частично выполняет задачу. НО: 1) приходится менять имя файла, чтобы он тянул нужный.. можно что-то сделать, чтобы макрос просто тянул каждый новый лист из папки ежесуточно? 2) Подтянутый лист вставляется в начало книги.. Как сделать так, чтобы лист вставлялся в конец? Max_Nesterov на форуме Обратить внимание администрации на это сообщение 0shtankovs
К сообщению приложен файл:15-__.xls
(55.0 Kb)
·
__.xlsx
(99.2 Kb)
Сообщение отредактировал shtankovs - Понедельник, 09.08.2021, 17:03
НомерФайла = Replace(ИмяПоследнегоЛиста, "-СБМ суточный рапорт.xls", "", , , vbTextCompare) 'заменяем без учета регистра If Not IsNumeric(НомерФайла) Then 'если не является числом НомерФайла Exit Sub '- выход из процедуры End If
If Dir(ПутьКФайлу) = "" Then 'если файл не существует ПутьКФайлу = Application.GetOpenFilename("Excel files(*-СБМ суточный рапорт.xls),*-СБМ суточный рапорт.xls", 1, "Выберите Excel файл", , False) 'то просим выбрать If VarType(ПутьКФайлу) = vbBoolean Then 'была нажата кнопка отмены Exit Sub '- выход из процедуры End If End If
Set НовыйЛист = ThisWorkbook.Sheets.Add(, ThisWorkbook.Sheets(ИмяПоследнегоЛиста)) 'добавляем лист в конец НовыйЛист.Name = Mid(ПутьКФайлу, InStrRev(ПутьКФайлу, "\") + 1) ' переименовываем лист End Sub
[/vba]
Здравствуйте. Можно определить имя следующего файла по имени последнего листа.
[vba]
Код
Public Sub ДобавлениеЛиста() Dim ПутьКФайлу, НомерФайла As String, ИмяПоследнегоЛиста As String Dim НовыйЛист As Object
НомерФайла = Replace(ИмяПоследнегоЛиста, "-СБМ суточный рапорт.xls", "", , , vbTextCompare) 'заменяем без учета регистра If Not IsNumeric(НомерФайла) Then 'если не является числом НомерФайла Exit Sub '- выход из процедуры End If
If Dir(ПутьКФайлу) = "" Then 'если файл не существует ПутьКФайлу = Application.GetOpenFilename("Excel files(*-СБМ суточный рапорт.xls),*-СБМ суточный рапорт.xls", 1, "Выберите Excel файл", , False) 'то просим выбрать If VarType(ПутьКФайлу) = vbBoolean Then 'была нажата кнопка отмены Exit Sub '- выход из процедуры End If End If
Set НовыйЛист = ThisWorkbook.Sheets.Add(, ThisWorkbook.Sheets(ИмяПоследнегоЛиста)) 'добавляем лист в конец НовыйЛист.Name = Mid(ПутьКФайлу, InStrRev(ПутьКФайлу, "\") + 1) ' переименовываем лист End Sub