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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.03.2015, 05:48   #1
pensodite
Новичок
Джуниор
 
Регистрация: 18.03.2015
Сообщений: 1
По умолчанию Копирование Subtotals из сводной таблицы

Уважаемые программисты,

Пожалуйста не пинайте меня если такая тема уже была (я бы почитала литературу для чайников при иных обстоятельствах, но в данный момент свободного времени совсем нет)

На работе надо сделать отчет. с VBA я никак...

кое-как создала выпадающий список и приписала к нему макрос, работает, но список пропадает каждый раз при открытии файла.

Почему?



Еще вот задача - чтобы из сводной таблицы подитоговые суммы по статье доходов/затрат (в зависимости от валюты) помесячно переносились в другой лист, тк на основе этих данных надо рассчитывать фин коэфф.
Я написала код, но выходит ошибка mysmatch (я не знаю, либо внутри самого кода или я запихиваю его не в тот лист, либо все вообще не правильно).

Sub Copy()
Dim ws as Worksheet, ws1 as Worksheet
Dim x as Range, y as Range, z as Range


Set ws = ("Summary")
Set ws1 = ("Results")

ActiveSheet.PivotTables("PivotTable 1")

With.RowRange

Set x = .Cell.Find(What:="RE1 Total", After:=.Cell(1), _ LookAt:=xlWhole, SearchDirection:=xlNext)
If x Is Nothing Then Worksheets("Summary").Range(ws.Cell s(4,3), ws.Cells(4,14).ClearContents
Set y = .Cells.Find(What:="EX1 Total", After:=x, _ LookAt:=xlWhole, SearchDirection:=xlNext)
If y Is Nothing Then
Worksheets("Summary").Range(ws.Cell s(7,3), ws.Cells(7,14).ClearContents
Set z = .Cells.Find(What:="EX3 Total", After:=y, _ LookAt:=xlWhole, SearchDirection:=xlNext)
If z Is Nothing Then
Worksheets("Summary").Range(ws.Cell s(8,3), ws.Cells(8,14).ClearContents

End If

End With

With Worksheet ws

Range(x).Copy.EntireRow
Destination:=Worksheet("Summary").R ange("D5")

Range(y).Copy.EntireRow
Destination:=Worksheet("Summary").R ange("D8")

Range(z).Copy.EntireRow
Destination:=Worksheet("Summary").R ange("D8")

End with

End sub

Помогите пожалуйста исправить
Спасибо всем откликнувшимся!
Вложения
Тип файла: zip KPI v2.zip (43.5 Кб, 5 просмотров)

Последний раз редактировалось pensodite; 18.03.2015 в 15:56.
pensodite вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Изменение сводной таблицы REztor Microsoft Office Excel 1 14.04.2012 13:30
Автофильтр из сводной таблицы Севастьянов Microsoft Office Excel 0 08.09.2011 11:55
Заполнение сводной таблицы Nikolas8 Microsoft Office Excel 1 04.06.2010 22:09
Данные из двух полей исх. таблицы в одно поле сводной таблицы Strelec79 Microsoft Office Excel 2 02.08.2009 13:59