Копирование листа в другую книгу макросом

[xamillion]

Помогите, пожайлуста, макросом копировать лист в другую книгу. То есть нужно из 2-х книг скопировать листы в 3-ю...

[EducatedFool]

Для начала неплохо было бы знать, из какой книги будет запускаться макрос, из каких книг (интересуют названия файлов) будут копироваться листы, как буде называться файл с результатом (каждый раз создавать новый файл или перезаписывать файл результат.xls), и т.д.

Сам код в принципе очень прост, но для его написания нужны все эти нюансы...


--------- примечание модератора - вдруг кому пригодится --------------

Надстройка LOOKUP предназначена для сравнения и подстановки значений в таблицах Excel.

Если вам надо сравнить 2 таблицы (по одному столбцу, или по нескольким),
и для совпадающих строк скопировать значения выбранных столбцов из одной таблицы в другую,
надстройка «Lookup» поможет сделать это нажатием одной кнопки.

В настройках программы можно задать:

• где искать сравниваемые файлы (использовать уже открытый файл, загружать файл по заданному пути, или же выводить диалоговое окно выбора файла)
• с каких листов брать данные (варианты: активный лист, лист с заданным номером или названием)
• какие столбцы сравнивать (можно задать несколько столбцов)
• значения каких столбцов надо копировать в найденные строки (также можно указать несколько столбцов)

Скачать надстройку для сравнения таблиц Excel и копирования данных из одинаковых строк

[xamillion]

Сообщение от EducatedFool

Для начала неплохо было бы знать, из какой книги будет запускаться макрос, из каких книг (интересуют названия файлов) будут копироваться листы, как буде называться файл с результатом (каждый раз создавать новый файл или перезаписывать файл результат.xls), и т.д.

Сам код в принципе очень прост, но для его написания нужны все эти нюансы...

Макрос будет запускаться из книги результат.xls, файл с результатом пусть так и называется результат.xls и каждый раз перезаписывается, книги откуда копируется лист будут называться 1.xls и 2.xls, и листы в них соответственно в книге 1.xls называется "1", в книге 2.xls называется "2", и чтоб в результирующем файле они так и назывались 1 и 2... Все просто, но что то никак не осилю...

[SAS888]

1. У Вас всего 3 книги? Т.е. рабочая и еще две? Или их может быть сколько угодно?
2. В книгах "1.xls" и "2.xls" только 1 лист? Если нет, то куда девать данные с других листов?
3. Если заранее известен диапазон (можно с избытком) ячеек листов исходных книг ("1.xls" и "2.xls"), то можно обойтись без их открытия - копирования - закрытия. Создаем ссылку на "закрытую" (кстати, не обязательно) книгу, затем удаляем связи, оставляя значения.

[xamillion]

Сообщение от SAS888

1. У Вас всего 3 книги? Т.е. рабочая и еще две? Или их может быть сколько угодно?
2. В книгах "1.xls" и "2.xls" только 1 лист? Если нет, то куда девать данные с других листов?
3. Если заранее известен диапазон (можно с избытком) ячеек листов исходных книг ("1.xls" и "2.xls"), то можно обойтись без их открытия - копирования - закрытия. Создаем ссылку на "закрытую" (кстати, не обязательно) книгу, затем удаляем связи, оставляя значения.

1. Книги всего три, рабочая и еще две!
2. В книгах "1.xls" и "2.xls" нужен только один лист,"1" и "2"!
3. Копирывать можно целый лист или диапазон (например, A1:M10000)... Лучше это был бы макрос....

[tolikman]

в реузльтат'е

dim book as workbook
dim cbook as workbook
dim nsheet as worksheet
dim prevsheet as worksheet
set cbook = activeWorkbook
set prevsheet = activeSheet

set book = workbooks.open(путь+"1.xls")
set nsheet = cbook.Sheets.Add(Type:=xlWorksheet) 
nsheet.name = "1"
book.sheets("1").Range("A1:M10000").copy destination:=nsheet.range("A1")
book.close false

set book = workbooks.open(путь+"2.xls")
set nsheet = cbook.Sheets.Add(Type:=xlWorksheet) 
nsheet.name = "2"
book.sheets("2").Range("A1:M10000").copy destination:=nsheet.range("A1")
book.close false

prevsheet.activate

[SAS888]

Если в книге "результат.xls" листы 1 и 2 подготовлены,т.е. нарисованы границы таблиц, то можно обойтись без открытия исходных файлов. Например, так:

Sub Main()
    Dim i As Integer
    Const myPath = "D:\Temp" 'Подставьте требуемый путь к папке.
    For i = 1 To 2
        Sheets(i).Select
        With Range("A1:M10000")
            .ClearContents
            .Formula = "='" & myPath & "\[" & i & ".xls]Лист1'!$A$1:$M$10000"
            .Value = .Value
            ActiveWindow.DisplayZeros = False
        End With
    Next
End Sub

[xamillion]

Сообщение от tolikman

в реузльтат'е

dim book as workbook
dim cbook as workbook
dim nsheet as worksheet
dim prevsheet as worksheet
set cbook = activeWorkbook
set prevsheet = activeSheet

set book = workbooks.open(путь+"1.xls")
set nsheet = cbook.Sheets.Add(Type:=xlWorksheet) 
nsheet.name = "1"
book.sheets("1").Range("A1:M10000").copy destination:=nsheet.range("A1")
book.close false

set book = workbooks.open(путь+"2.xls")
set nsheet = cbook.Sheets.Add(Type:=xlWorksheet) 
nsheet.name = "2"
book.sheets("2").Range("A1:M10000").copy destination:=nsheet.range("A1")
book.close false

prevsheet.activate

в целом годится... спасибо...

Сообщение от SAS888

Если в книге "результат.xls" листы 1 и 2 подготовлены,т.е. нарисованы границы таблиц, то можно обойтись без открытия исходных файлов. Например, так:

Sub Main()
    Dim i As Integer
    Const myPath = "D:\Temp" 'Подставьте требуемый путь к папке.
    For i = 1 To 2
        Sheets(i).Select
        With Range("A1:M10000")
            .ClearContents
            .Formula = "='" & myPath & "\[" & i & ".xls]Лист1'!$A$1:$M$10000"
            .Value = .Value
            ActiveWindow.DisplayZeros = False
        End With
    Next
End Sub

заполняет весь диапазон "#ССЫЛКА!"...


может как то можно копирывать весь лист?

[SAS888]

заполняет весь диапазон "#ССЫЛКА!"

Значит макрос не находит требуемые файлы по заданному пути. Вы либо не изменили прописанный в коде макроса путь, либо указали неверный путь к папке с файлами.
Ну, а если открывать и копировать, то можно, например, так:

Sub Main()
    Dim i As Integer
    Application.ScreenUpdating = False
    Const myPath = "D:\Temp" 'Подставьте требуемый путь к папке.
    For i = 1 To 2
        With ThisWorkbook.Sheets(i)
        Workbooks.Open Filename:=myPath & Application.PathSeparator & i & ".xls"
        Cells.Copy .[A1]
        ActiveWorkbook.Close SaveChanges = False
        End With
    Next
End Sub

Если же файл с макросом находится в той же папке, что и файлы "1.xls" и "2.xls", то можно так:

Sub Main()
    Dim i As Integer
    Application.ScreenUpdating = False
    For i = 1 To 2
        With ThisWorkbook.Sheets(i)
        Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & i & ".xls"
        Cells.Copy .[A1]
        ActiveWorkbook.Close SaveChanges = False
        End With
    Next
End Sub

[xamillion]

Спасибо, очень помогло