Добрый день, нужна помощь в доработке макроса ниже: В исходном варианте он копирует лист 1 из указанного набора книг в текущую книгу. Хотелось бы, чтобы он копировал указанный диапазон (А1:A13) со всех листов 1 (также из всех выбранных книг) но начиная с выделенной мной ячейки текущей книги, в столбец слева направо. (например столбец А,B) А при появлении новых книг, новые данные добавлял бы данные, начиная со столба С. И т.д.
Подскажите как корректно изменить код? [vba]
Код
Sub CombineWorkbooks() Dim FilesToOpen Dim x As Integer
Application.ScreenUpdating = False 'отключаем обновление экрана для скорости
'вызываем диалог выбора файлов для импорта FilesToOpen = Application.GetOpenFilename _ (FileFilter:="All files (*.*), *.*", _ MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then MsgBox "Не выбрано ни одного файла!" Exit Sub End If
'проходим по всем выбранным файлам x = 1 While x <= UBound(FilesToOpen) Set importWB = Workbooks.Open(Filename:=FilesToOpen(x)) Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) importWB.Close savechanges:=False x = x + 1 Wend
Application.ScreenUpdating = True End Sub
[/vba]
Добрый день, нужна помощь в доработке макроса ниже: В исходном варианте он копирует лист 1 из указанного набора книг в текущую книгу. Хотелось бы, чтобы он копировал указанный диапазон (А1:A13) со всех листов 1 (также из всех выбранных книг) но начиная с выделенной мной ячейки текущей книги, в столбец слева направо. (например столбец А,B) А при появлении новых книг, новые данные добавлял бы данные, начиная со столба С. И т.д.
Подскажите как корректно изменить код? [vba]
Код
Sub CombineWorkbooks() Dim FilesToOpen Dim x As Integer
Application.ScreenUpdating = False 'отключаем обновление экрана для скорости
'вызываем диалог выбора файлов для импорта FilesToOpen = Application.GetOpenFilename _ (FileFilter:="All files (*.*), *.*", _ MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then MsgBox "Не выбрано ни одного файла!" Exit Sub End If
'проходим по всем выбранным файлам x = 1 While x <= UBound(FilesToOpen) Set importWB = Workbooks.Open(Filename:=FilesToOpen(x)) Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) importWB.Close savechanges:=False x = x + 1 Wend