Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Главное меню

Разбивание таблицы на части (листы в 1 книге)

Автор Goin2010, 14.10.2013, 15:35

« назад - далее »

Goin2010

Добрый день. Нужна помощь в написании макроса.
Есть таблица материалов и складов.
Необходимо ее разбить так, чтобы каждый склад был на новом листе книги и из основной таблицы переносились данные количества материалов, а также сводная таблица в один столбец.
Пример прилагается.
p.s. список материалов может быть очень большим.

Poltava

Каждый раз это будет новая таблица или нужно будет обновлять данные на листах
Не пытайтесь спорить с дебилом. Иначе вы опуститесь до его уровня. Где он задавит вас своим опытом.

Goin2010

Цитата: Poltava от 14.10.2013, 20:06
Каждый раз это будет новая таблица или нужно будет обновлять данные на листах

Каждый раз будет новая таблица (она формируется 1 раз в месяц).

kuklp

Public Sub www()
    Dim a, i&, j&, k&, n&, m&
    a = [a3].CurrentRegion
    k = [a3].CurrentRegion.SpecialCells(2, 1).Count
    ReDim b(1 To UBound(a), 1 To 2)
    ReDim c(1 To k, 1 To 2)
    For j = 2 To UBound(a, 2)
        With Worksheets.Add
            .Move after:=Worksheets(Worksheets.Count)
            .Name = a(1, j)
            For i = 2 To UBound(a)
                If a(i, j) <> "" Then
                    n = n + 1: m = m + 1
                    b(n, 1) = a(i, 1): b(n, 2) = a(i, j)
                    c(m, 1) = a(i, 1): c(m, 2) = a(i, j)
                End If
            Next
            .[a3].Resize(n, 2) = b
        End With
        n = 0
    Next
    With Worksheets.Add
        .Move after:=Worksheets(Worksheets.Count)
        .Name = "СВОДНАЯ"
        .[a3].Resize(m, 2) = c
    End With
End Sub

Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771