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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир 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]
Код
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

Автор - shtankovs
Дата добавления - 09.08.2021 в 15:28
Erjoma1981 Дата: Среда, 11.08.2021, 09:50 | Сообщение № 2
Группа: Проверенные
Ранг: Новичок
Сообщений: 32
Репутация: 16 ±
Замечаний: 0% ±

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

[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]
 
Ответить
СообщениеЗдравствуйте.
Можно определить имя следующего файла по имени последнего листа.

[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]

Автор - Erjoma1981
Дата добавления - 11.08.2021 в 09:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для копирования листа из книги в одну общую книгу (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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