{quote}{login=TEG}{date=13.06.2010 06:28}{thema=Сводная таблица средствами VBA}{post}P/S могу выложить свой код, но он не работает как нужно{/post}{/quote}Выложите и скажите, что не работает и как нужно.  
Ps честно говоря не понятно, зачем сводную делать средствами VBA?

Sub Сводные2()  
 
Dim bazaWb As Workbook 'текущая книга (общий файл)  
Dim bazaSht As Worksheet 'лист Baza в общем файле  
Dim pvtSht As Worksheet  'лист для сводной в общем файле  
Dim pvtSht2 As Worksheet 'лист для значений  
Dim PTCache As PivotCache 'переменная для записи исходных данных сводной табл  
Dim pt As PivotTable      'переменная сводной табл  
Dim iFirmRow As Long, iRow As Long, iCol As Long, i As Long, k As Integer  
Dim myCountA As Integer  
Dim myCountA2 As Integer  
Dim myPvtRng As Range, d As Range  
Dim toCopyData As Range  
Dim Nomen As Range  
Dim iFill As Range  
 
Set bazaWb = ActiveWorkbook  
Set pvtSht = Sheets.Add  
pvtSht.Name = "Сводная"  
   Set bazaSht = bazaWb.Sheets("sheet1")  
     
   'Range("a1").Activate  
   bazaSht.Columns("A:A").AutoFilter Field:=1, Criteria1:="=*итого*", Operator:=xlAnd  
     
   iRow = bazaSht.Cells(Rows.Count, 4).End(xlUp).Row  
   'iFill = bazaSht.Range(bazaSht.Cells(1, 1), bazaSht.Cells(Rows.Count, 4).End(xlUp).Row)  
    bazaSht.Range(bazaSht.Cells(1, 1), bazaSht.Cells(iRow, 4)).Copy  
     
   Sheets.Add  
   bazaWb.Worksheets("лист2").Range("a1").PasteSpecial Paste:=xlPasteValues  
   Columns("b:B").Value = Columns("b:B").Value  
 
 'Set myPvtRng = bazaSht.Range(bazaSht.Cells(1, 1), bazaSht.Cells(bazaSht.Cells(Rows.Count, 1).End(xlUp).Row, bazaSht.Cells(bazaSht.Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).End(xlToLeft).Column))  
 
  Worksheets("лист2").Activate  
  ActiveCell.Offset(0, 1).FormulaR1C1 = "Код позиции"  
  ActiveCell.Offset(0, 2).FormulaR1C1 = "факт у продаже"  
  ActiveCell.Offset(0, 3).FormulaR1C1 = "факт остаток"  
   
   'Set Nomen = Range(Cells(1, 2), Cells(2, 250)).Cells.Find("Код позиции", , xlFormulas, xlWhole)  
   'If Not Nomen Is Nothing Then Nomen.Activate  
   'Nomen.Offset(1, 0).Activate  
  ' iCol = ActiveCell.Column  
     
   iRow = Cells(Rows.Count, 1).End(xlUp).Row  
   'Range("D65000").Copy 'пустая ячейка  
   'Range(Cells(2, iCol), Cells(iRow, iCol)).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd  
   Range(Cells(2, 2), Cells(iRow, 2)).Replace "П", "", LookAt:=xlPart  
   Range(Cells(2, 2), Cells(iRow, 2)).Replace "Ф", "", LookAt:=xlPart  
   Set myPvtRng = Range(Cells(1, 2), Cells(iRow, 4))  
   Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _  
    SourceData:=myPvtRng.Address)  
     
   Set pt = PTCache.CreatePivotTable(TableDestination:=pvtSht.Range("A3"), TableName:="Таблица")  
     
   With pvtSht.PivotTables("Таблица").PivotFields("Код позиции")  
       .Orientation = xlRowField  
       .Position = 1  
   End With  
   pvtSht.PivotTables("Таблица").AddDataField pvtSht.PivotTables _  
       ("Таблица").PivotFields("факт у продаже"), _  
       "Сумма факт у продаже", xlSum  
         
 вот тут пишет: ошибка аргумента. не знаю, почему   -    pvtSht.PivotTables("Таблица").AddDataField pvtSht.PivotTables _  
       ("Таблица").PivotFields("факт остаток"), _  
       "факт остаток", xlSum  
   
     Set myPvtRng = pvtSht.Range(pvtSht.Cells(1, 1), pvtSht.Cells(pvtSht.Cells(Rows.Count, 1).End(xlUp).Row, pvtSht.Cells(pvtSht.Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).End(xlToLeft).Column))  
 
     myPvtRng.Copy  
     Workbooks("матрицаШT.xls").Worksheets("лист1").Range("a1").PasteSpecial Paste:=xlPasteValues  
End Sub