Evo probaj sa sledecim kodom.
Najpre selektuj tvoju tabelu pa pozovi ovu proceduru a ona ce napraviti
listu vrednosti od kojih je ovaj izvestaj mogao kao pivot da nastane.
Podaci se kopiraju na Sheet2, a to bi moglo dalje da se podesava.
Code:
Private Sub RePivot()
Dim lRows As Long
Dim lCols As Long
Dim lr As Long
Dim lc As Long
Dim tbl As Range
Dim tm As Variant
Dim tl As Variant
Dim val As Variant
Set tbl = ActiveCell.CurrentRegion
lRows = tbl.Rows.Count
lCols = tbl.Columns.Count
If lorws = 1 Or lCols = 1 Then
MsgBox "Selekcija mora biti veca!", vbCritical, "Greska"
Else
Sheets("Sheet2").Activate
For lr = 2 To lRows
For lc = 2 To lCols
tm = tbl.Offset(0, lc - 1).Resize(1, 1).Value
tl = tbl.Offset(lr - 1, 0).Resize(1, 1).Value
val = tbl.Offset(lr - 1, lc - 1).Resize(1, 1).Value
If val <> "" Then
ActiveCell.FormulaR1C1 = tl
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = tm
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = val
ActiveCell.Offset(1, -2).Range("A1").Select
End If
Next
Next
End If
End Sub
Pozdrav