Из нескольких EXCEL Документов(файлов) надо копировать определенные листы полностью в общий Документ, а некоторые (листы) на определённую позицию общего Документа. Как поступить???
НАДО:
1. из файлов 1й склад.xlsm и 2й склад.xlsm в файл ALL.xlsm скопировать на листы “1й склад” и “2й склад” листы “1й склад” и “2й склад” соответственно ( со всей структурой листа исходника).
(см. Прилоджение)
2. из файлов 1й склад.xlsm и 2й склад.xlsm в файл ALL.xlsm скопировать на листы “Отгруженный товар ” и “Оприходованный товар ” соответствующие таблицы (из 1.xlsm и 2.xlsm). Причем, количество строк в таблице “Отгруженный товар ” (“Оприходованный товар ”) в исходных файлах (1.xlsm и 2.xlsm) может меняться (т.е. много записей или мало)
(см. Прилоджение)
3. Требуется реализовать окно выбора фалов, т.к. имена файлов ежеквартально меняются.
Маска имени файла: “2й склад_(ДАТА).xlsm” (“1й склад_(ДАТА).xlsm”).
(см. Прилоджение)
Решая подобную задачу, нашел макрос (), но не совсем подходит. Он (макрос) после выбора нужных файлов для выбора просто переносит листы (порождая новые), а надо чтобы копировал. Проблему №2 он вообще не решает.
Ниже привожу указанный выше макрос. Изменил лишь маску файлов на *.xlm.
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlm), *.xlm", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
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
НАДО:
1. из файлов 1й склад.xlsm и 2й склад.xlsm в файл ALL.xlsm скопировать на листы “1й склад” и “2й склад” листы “1й склад” и “2й склад” соответственно ( со всей структурой листа исходника).
(см. Прилоджение)
2. из файлов 1й склад.xlsm и 2й склад.xlsm в файл ALL.xlsm скопировать на листы “Отгруженный товар ” и “Оприходованный товар ” соответствующие таблицы (из 1.xlsm и 2.xlsm). Причем, количество строк в таблице “Отгруженный товар ” (“Оприходованный товар ”) в исходных файлах (1.xlsm и 2.xlsm) может меняться (т.е. много записей или мало)
(см. Прилоджение)
3. Требуется реализовать окно выбора фалов, т.к. имена файлов ежеквартально меняются.
Маска имени файла: “2й склад_(ДАТА).xlsm” (“1й склад_(ДАТА).xlsm”).
(см. Прилоджение)
Решая подобную задачу, нашел макрос (), но не совсем подходит. Он (макрос) после выбора нужных файлов для выбора просто переносит листы (порождая новые), а надо чтобы копировал. Проблему №2 он вообще не решает.
Ниже привожу указанный выше макрос. Изменил лишь маску файлов на *.xlm.
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlm), *.xlm", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
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
