VBA Excel

[ChelSI]

Есть знающие люди по данному направлению?

Помогите с написанием макроса.

Что имеем

папка 0 с некой вложенностью

1-1х

2-2х

3-3х

где 1 - имя папки. 1х - имя файла xls и т.д.

в каждом фале по одному листу одной и той же структуры

Требуется

в файл 1х по нажатию кнопы с заменой данных копировались записи. сначала с файла 2х, потом 3х.. (1х сводный файл)

 

пысы:папок на самом деле много... так бы ручками не напрягаясь делал раз в неделю

 

вот нашел пример. но там немного не то

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

Изменено 1 октября, 2012 пользователем ChelSI

[ChelSI]

как добраться до листа в закрытой книге не открывая ее?

[KaN]

ChelSI, завтра постараюсь доделать тебе программу, сегодня уже поздно

[ChelSI]

ChelSI, завтра постараюсь доделать тебе программу, сегодня уже поздно

 

спс, сегодня выложу что сам навоял. не до конца конечно... но всё же

[ChelSI]

Sub Кнопка2_Щелчок()

 

Range("A11").Select (до A11 шапка )

перед вставкой удаляем все имеющиеся данные, соответственно до шапки

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select - выделяем

Selection.Delete Shift:=xlUp - удаляем

Range("A11").Select встаем на начало заполнения таблицы

 

 

 

Workbooks.Open("D:\1\2.xlsx").Activate - открываем интересующий нас файл

Range("A11").Select встаем так же на начало таблицы

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select выделяем ее

Selection.Copy копируем

 

 

Windows("Копия.xlsm").Activate переходим в общую базу

ActiveSheet.Paste вставляем, активная ячейка на этом этапе А11

 

lr = Cells(Rows.Count, 2).End(xlUp).Row находим во втором столбце последнюю запись и присваиваем переменной lr значение записи ( это сделано для того. чтобы исключить переход по пустым ячейкам которые копируются с форматированием но без данных (косяки юзеров)

Cells(lr + 1, 1).Select и переходим на ячейку ниже но уже в первом столбце

Selection.Copy освобождаем буфер

Workbooks("2.xlsx").Close закрываем первый файл с которого было копирование данных

 

 

Workbooks.Open("D:\1\3.xlsx").Activate открываем второй файл

Range("A11").Select встаем на начало таблицы

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select выделяем ее аналогично первому

Selection.Copy копируем

 

 

Windows("Копия.xlsm").Activate переходим на главную таблицу

ActiveSheet.Paste вставляем

 

аналогично как и с первым файлом проводим операции

lr = Cells(Rows.Count, 2).End(xlUp).Row

Cells(lr + 1, 1).Select

Selection.Copy

Workbooks("3.xlsx").Close

 

т.к. копирование идет из разных таблиц, то порядковый номер будет заполнен неверно

Range("A11").Select переходим на начало общей таблицы

 

Dim i As Long база большая/ поэтому long

в цикле заполняем порядковые номера базы

For i = 1 To lr - 10

ActiveCell.FormulaR1C1 = i

Cells(11 + i, 1).Select

Next i

 

End Sub

[ChelSI]

если есть замечания - с удовольствием выслушаю

пысы: коменты писал уже тут. так что если кто захочет воспользоваться - или закомментируйте, или удалите

[ChelSI]

сейчас подумываю о проверке файла на его наличие

[KaN]

Вот сделал программку.

Постарался сделать, чтобы была универсальней и быстро работала, не знаю какие у тебя файлы по размеру.

из файлов копируются диапазоны с А11 и до последней заполненной ячейки, не важно какой столбец или строка

не проверял с очень большими таблицами, например 50 тыс строк, хотя должно работать

не стал заморачиваться проверками особо, это можно и потом сделать, исходил из твоих начальных требований:

папки строго 1,2,3,4 и т.д.

файлы в них тоже 1.xlsx и т.д.

пропусков быть не должно, иначе неправильно отработает.

На самом деле хотел сделать, чтобы читались подряд папки с текущей и все xlsx файлы в них, но потом подумал вдруг у тебя будут файлы, которые не надо читать.

Вообщем прогу теперь можно улучшать еще долго.

Пиши пожелания, чего поправить, но оперативного ответа не обещаю.

 

P.S. в инете куча сайтов с примерами, но большая часть готовых функций не работает, либо написано с ошибками, а может для старых версий excel.

пример.rar