Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.08.2015, 07:01   #1
sanych_09
Пользователь
 
Аватар для sanych_09
 
Регистрация: 18.01.2011
Сообщений: 75
По умолчанию Собрать листы по критерию в один или собрать файлы в определенные листы

Доброго времени суток!
нужна помощь по сборке листов в один

есть 17 файлов. макрос по сборке их в одну книгу есть (благодаря добрым людям). тема: http://www.programmersforum.ru/showthread.php?t=280871


нашел в сети код, которые собирает все листы книги в один.
Код:
Sub combine_sheet()
Dim iRng As Range
Dim iRngAddress As String, oAwb As String, oFile
Dim lLastRow As Long, lLastRowMyBook As Long
Dim iLastColumn As Integer, iCount As Integer
Dim Str() As String

Application.ScreenUpdating = False
iCount = 0
For Each Sheet In Sheets
 If Sheet.Name <> "FTK" Then
   Sheet.Activate
    iCount = iCount + 1
     lLastRow = Cells(1, 1).SpecialCells(xlLastCell).Row
    iLastColumn = Cells(1, 1).SpecialCells(xlLastCell).Column
   lLastRowMySheet = ThisWorkbook.Worksheets("FTK").Cells.SpecialCells(xlLastCell).Row
     If iCount = 1 Then
      lLastRowMySheet = 1
      iRngAddress = Range(Cells(lLastRowMySheet, 1), Cells(lLastRowMySheet + lLastRow - 1, iLastColumn)).Address
       Sheet.Range(Cells(1, 1), Cells(lLastRow, iLastColumn)).Copy Destination:=ThisWorkbook.Worksheets("FTK").Range(iRngAddress)
     Else
      iRngAddress = Range(Cells(lLastRowMySheet + 1, 1), Cells(lLastRowMySheet + lLastRow, iLastColumn)).Address
       Sheet.Range(Cells(2, 1), Cells(lLastRow, iLastColumn)).Copy Destination:=ThisWorkbook.Worksheets("FTK").Range(iRngAddress)
     End If
  End If
Next Sheet
Worksheets("FTK").Activate
Application.ScreenUpdating = True
End Sub

есть 5 основных листов FTK, TS, Colo, Upg, EXP (да данный момент), в которые нужно собрать инфу с других листов cоответствующих проектов FTK = (PH1_FTK_DPR, PH2_FTK_DPR, PH2_FTK_DPR)
....


1. Можно ли модернизировать код выше, чтобы макрос сам находил лист имя которого содержит "FTK" и сам вставлял его в один общий лист FTK, но при этом нужно было бы вставить еще имя листа в отдельный столбик

2. Может легче собрать информацию непосредственно с готовых файлов? Есть 17 файлов в именах которых содержится нужная информация (пример ниже)
FlNm(1) = "PH1_New_Colocation_DPR_NEW_*.c sv"
FlNm(2) = "PH1_FTK_DPR_NEW_*.csv"
......
FlNm(17)

и вставить их в нужные листы FTK, Colo, TS, Upg, Exp.

чтобы не выполнять сразу 2 макроса подряд


имея такой файлик всего их 5 листов, легко делать сводный отчет (либо pivot table, либо же формулами Счетеслимного и т.д)


заранее спасибо!
Вложения
Тип файла: rar COMBINE SHEETS.rar (22.1 Кб, 27 просмотров)

Последний раз редактировалось sanych_09; 05.08.2015 в 07:14. Причина: добавлен файл
sanych_09 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как собрать софт в один файл? mikelkenneth Свободное общение 3 19.04.2012 02:15
сто кусков собрать в один в Excel ЮнныйДжедай Помощь студентам 0 27.10.2011 19:08
Как скопировать определенные листы из одной книги в другую? Toffifee Microsoft Office Excel 32 20.05.2011 12:25
решил собрать комп, из 3-х нерабочих один рабочий. alex(21) Компьютерное железо 35 08.03.2010 14:19