Макрос для копирования листа из книги в одну общую книгу

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для копирования листа из книги в одну общую книгу (Макросы/Sub)

shtankovs

Дата: Понедельник, 09.08.2021, 15:28 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 20% ±

Добрый день!
Есть одна книга 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

К сообщению приложен файл: 15-__.xls (55.0 Kb) · __.xlsx (99.2 Kb)

Сообщение отредактировал shtankovs - Понедельник, 09.08.2021, 17:03

Ответить

СообщениеДобрый день!
Есть одна книга excel, в которую будут собираться ежедневные суточные рапорты, каждый из которых представляет из себя отдельный лист excel. Нужен макрос, который будет подтягивать поступающие рапорты.
Имя каждого нового листа - "15 -СБМ суточный рапорт". В каждом последующем рапорте в имени меняться будет только цифра, типа: 15, 16, 17, 18 и т.д.
Основная книга имеет название "Анализ по БР"
(файлы примеры во вложении)
Основная книга и поступающие рапорты хранятся строго в одной попке
Если это технически возможно, прошу вас помочь!

[vba]

Код

Автор - shtankovs
Дата добавления - 09.08.2021 в 15:28

Erjoma1981

Дата: Среда, 11.08.2021, 09:50 | Сообщение № 2

Группа: Проверенные

Ранг: Участник

Сообщений: 66

Репутация: 25 ±

Замечаний: 0% ±

Excel 2010, 2019

Здравствуйте.
Можно определить имя следующего файла по имени последнего листа.

[vba]

Код

Public Sub ДобавлениеЛиста()
    Dim ПутьКФайлу, НомерФайла As String, ИмяПоследнегоЛиста As String
    Dim НовыйЛист As Object

    ИмяПоследнегоЛиста = Worksheets(Worksheets.Count).Name

    НомерФайла = Replace(ИмяПоследнегоЛиста, "-СБМ суточный рапорт.xls", "", , , vbTextCompare) 'заменяем без учета регистра
    If Not IsNumeric(НомерФайла) Then 'если не является числом НомерФайла
        Exit Sub '- выход из процедуры
    End If

    ПутьКФайлу = ThisWorkbook.Path & "\" & CStr(1 + CInt(НомерФайла)) & "-СБМ суточный рапорт.xls"

    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]

Ответить

Страница 1 из 1
1