Страницы: 1
RSS
Соединить листы из разных файлов в одну книгу.
 
Здравствуйте! Помогите, пожалуйста. Есть большой список файлов, защищенных паролем. В книгу необходимо собрать макросом листы из этих файлов. Так как наименование файлов и листов меняется, то данные собраны в таблице.

ПОЖАЛУЙСТА!  
Изменено: yelena321 - 21.08.2018 14:54:02
 
yelena321, используйте надстройку PLEX
вот сюда
Изменено: ivanok_v2 - 21.08.2018 13:11:30
 
У меня бюджетное медицинское учреждение. Установить какое приложение просто так не удастся, нет прав администратора. Может кто-нибудь поможет с макросом. Очень срочно нужно.
 
в примере - имя файла - C:\Users\Documents\2
это больше похоже на имя папки, к тому же там же Имя книги =1. Имя файла нужно с расширением
Цитата
yelena321 написал:
собрать макросом листы из этих файлов
и получить книгу с большим количеством листов? Если Вы знаете, что дальше делать с этими листами, хорошо, но скорее всего потом будут вопросы что-то типа как собрать все на один лист, или как посчитать во всем листам что-то по условию
 
С такими данными собрать не получится. Что за таблицы какие куда сколько столбцов одинаковое ли количество и многое многое другое.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
Нет. С этим я разберусь. Вопрос только собрать  листы в книгу.
 
Мне необходимо перенести лист целиком.
 
вариант. Скопирует все листы со всех указанных книг в книгу со списком.
Код
Sub sbor()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Worksheet, wsh As Worksheet, wb As Workbook
Set sh = ActiveSheet
i = 3
Do While sh.Cells(i, 1).Value <> ""
    pth = sh.Cells(i, 1).Value & "\" & sh.Cells(i, 3).Value
    Set wb = Workbooks.Open(pth, , , , sh.Cells(i, 2).Value)
    For Each wsh In wb.Worksheets
        wsh.Copy after:=sh
    Next
    wb.Close 0
    i = i + 1
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Общий макрос переноса листов из всех файлов Excel одной папки в книгу с макросом.
Код
Sub test()
'   ----------------------------------
    Dim sht As Worksheet
    Dim fName$, iPath$, ibook As Workbook
'   ----------------------------------
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
    Set ibook = ThisWorkbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then iPath = .SelectedItems(1) Else Exit Sub
    End With
    fName = Dir(iPath & Application.PathSeparator & "*.xls*")
    Do Until fName = ""
        With GetObject(iPath & Application.PathSeparator & fName)
            For Each sht In .Worksheets
                sht.Copy after:=ibook.Worksheets(ibook.Sheets.Count)
            Next sht
            .Close False
        End With
        fName = Dir
    Loop
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
End Sub
Изменено: Nordheim - 21.08.2018 14:20:41
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, а как же пароль на открытие файла?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Он переносит все листы. А надо чтобы определенный лист (я поменяла табличку и я глупая). Пожалуйста!!!!
Изменено: yelena321 - 21.08.2018 14:54:41
 
Код
Sub sbor()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Worksheet, wb As Workbook
Set sh = ActiveSheet
i = 3
Do While sh.Cells(i, 1).Value <> ""
    pth = sh.Cells(i, 1).Value & "\" & sh.Cells(i, 3).Value
    Set wb = Workbooks.Open(pth, , , , sh.Cells(i, 2).Value)
        wb.Worksheets(sh.cells(i,4).value).Copy after:=sh
    wb.Close 0
    i = i + 1
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Изменено: yozhik - 21.08.2018 14:35:14
 
yozhik, он переносит только первый по списку и цепляет еще один лист.
Изменено: yelena321 - 21.08.2018 14:38:50
 
Цитата
yelena321 написал:
надо чтобы определенный лист
Цитата
yelena321 написал:
он переносит только первый по списку
напишите более конкретно что и как надо переносить. Иначе помогать уже никто не будет, т.к. слишком непонятно что Вам вообще в итоге надо.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
От тут как-то и я в свое время не разобрался, да так руки и не дошли, если имя листа "1" как объяснить экселю в vba что это имя, а не индекс..)
Мысль пришла, может не Value, а cells(i, 4).Text использовать?  
Изменено: yozhik - 21.08.2018 14:41:44
 
В файле списком указано: папка, где находится файл, пароль и имя листа, которого необходимо переместить.
 
Код
Sub sbor()
'    -----------------------------------
    Dim sht As Worksheet, book As Workbook
    Dim fName$, iPath$, lRow&, iPassword, shtname$
'    -----------------------------------
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With

    Set sht = ThisWorkbook.Worksheets("Лист1")
    With sht
        lRow = .Range("a" & .Rows.Count).End(xlUp).Row
        For i = 3 To lRow
            iPath = .Range("a" & i).Value & Application.PathSeparator & .Range("c" & i)
            iPassword = .Range("b" & i).Value
            shtname = .Range("d" & i).Value
            Set book = Workbooks.Open(iPath, Password:=iPassword)
            book.Worksheets(shtname).Copy after:=sht
            book.Close False
        Next i
    End With
    With Application
        .ScreenUpdating =True: .DisplayAlerts = True
    End With
End Sub
Изменено: Nordheim - 21.08.2018 14:57:33
"Все гениальное просто, а все простое гениально!!!"
 
yelena321, с Вашим изменением имени листа с "1" на "Август" должно и так работать. Если в 10-й строке заменить Value на Text будет работать и с именем листа "1"
 
Nordheim, все работает. СПАСИБО ВСЕМ!  
 
Цитата
yozhik написал:
как объяснить экселю в vba что это имя, а не индекс
Код
wb.Worksheets(CStr(sh.cells(i,4).value)).Copy after:=sh
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,  спасибо, попробовал sh.cells(i,4).text, тоже сработало как надо
Страницы: 1
Наверх