Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Объединение нескольких книг по след принципу.
 
День добрый.  
 
Знатоки подскажите как можно решить нормаль и правильно задачу.  
Имеем кучу книг штук скажем 400 с одинаковым шаблоном ,то есть внутри каждого документа имеется таблица с разными данными клиентов, находится она только в Лист1, а выше и ниже таблички имеем ненужную инфу (одинаковую) пример такого документа прикрепил.  
 
Дальше, количество клиентов в таблице разное, может быть один , а может 20 тыс.  
 
И так задача склеить все книги в одну но при этом что бы клеилось только таблица с клиентами. Я решил задачу, но через задницу, хотелось бы узнать как можно правильно это сделать.  
 
мое решение:  
 
1)    
Sub makr1()  
   Dim myName As String, Wb As Workbook  
   
   myName = Dir("c:\in\" & "*.xlsx")  
   With ThisWorkbook.Sheets(1)  
       Do While myName <> ""  
           Set Wb = Workbooks.Open(Filename:="c:\in\" & myName)  
           ActiveSheet.UsedRange.Copy .Cells(.UsedRange.Rows.Count + .UsedRange.Row, "A")  
           Wb.Close SaveChanges:=False  
           myName = Dir  
       Loop  
   End With  
 
MsgBox ("Выполнено")  
 
End Sub  
---------------------------------  
дальше получив книгу со всеми данными начал их фильтровать, а имеено заменять шаблонные надписи в первом столбце на пустые ячейки, что б дальше их грохнуть (напомню пример в приложении)  
2)  
 
Sub Makr2()  
'  
   Cells.Replace What:="Чуш", Replacement:="", LookAt:=xlPart, SearchOrder _  
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
 
   Cells.Replace What:="что то еще", Replacement:="", LookAt:=xlPart, SearchOrder _  
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
 
 Cells.Replace What:="Одобрено Мин-чемто", Replacement:="", LookAt:=xlPart, SearchOrder _  
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
 
 Cells.Replace What:="Код клиента", Replacement:="", LookAt:=xlPart, SearchOrder _  
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
 
End Sub  
-----------------  
А дальше убил все рядки в которых ячейка с первого столбца пустая  
 
3)  
 
Sub DeleteEmptyRowsColumns()  
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
Application.ScreenUpdating = False  
For r = LastRow To 1 Step -1  
If Application.Rows®.Columns(1).Value = "" Then Rows®.Delete  
Next r  
End Sub  
--------------------  
 
Одним словом кто знает помогите сделать так что б данные объединялись начиная след рядка после ключевой ячейки "Код клиента" и до первой пустой ячейки.. а дальше начиналась выборка по другой книге точно также... и т.д.
Страницы: 1
Наверх