Сводные таблицы

[Termit7777]

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

Сократи файлик а то 3 метра не хотся грузить

Все сделал посмотри пож.

[Watcher_1]

Такой вариант пойдет?

Sub ЗаполнениеСводнойТаблицы()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    
    Dim coll As New Collection, wb As Workbook, sh As Worksheet, newRow As Range
    Mask = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "*.*")
    
    Filename = Dir(Mask)
    While Filename <> ""    ' перебираем все файлы в текущей папке
        If Not Filename Like ThisWorkbook.Name & "*" Then coll.Add Filename
        Filename = Dir
    Wend

    'For Each Item In coll: Debug.Print Item: Next
    On Error Resume Next
    s = 4
    For Each Item In coll
        Set wb = Workbooks.Open(Replace(ThisWorkbook.FullName, ThisWorkbook.Name, Item), , True)
        DoEvents
        If Not wb Is Nothing Then
            Set sh = wb.Worksheets(1)
            LastRow = sh.Range("a65000").End(xlUp).Row
            If LastRow > 4 Then    ' если есть заполненные строки
                 sh.Rows(5 & ":" & LastRow).Copy Me.Range("A" & s)
                 s = s + LastRow
            End If
            wb.Close False
        End If
    Next
    Me.Columns("A:W").Columns("A:W").EntireColumn.AutoFit
    Application.DisplayAlerts = True
End Sub

[Termit7777]

Пасибки огромное работает в разы быстрей и не лагает машинку)

[Termit7777]

А как нормально организовать такую штуку : есть столбец продажи и столбец категория a b с x суть такая если продажи лоря 100 грн.-x
200-b 300-c 400-x как организовать чтоб формулами автоматом выставлять категорию исходя из продаж по лорю? формулами не смог добиться корректной работы т.к в excel на уровни пользователя. За ранние пасиб.

[Termit7777]

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

А как нормально организовать такую штуку : есть столбец продажи и столбец категория a b с x суть такая если продажи лоря 100 грн.-x
200-b 300-c 400-x как организовать чтоб формулами автоматом выставлять категорию исходя из продаж по лорю? формулами не смог добиться корректной работы т.к в excel на уровни пользователя. За ранние пасиб.

Суммы пост меняются.