Копирование/перенос Subtotals из сводной таблицы по статьям и месяцам

Автор pensodite, 18.03.2015, 16:48

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

pensodite

Уважаемые форумчане, я не знаю если такая тема уже была (извините заранее)

На работе надо сделать отчет. с 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

Помогите пожалуйста
Спасибо всем откликнувшимся!

vikttur

1. Один вопрос - одна тема. Первый вопрос удален.
2. Для оформления кода есть кнопка на панели форматирования (оформление кода исправлено)
3. Не нужно столько пустых строк в сообщении (лишние пустые удалены)