Want to Run this code as a Personal Marco

[Navi_G]

Respected Experts,

I have a code for making my report I am facing a problem in running it as a personal macro.
When I save it as a personal macro line

 uba2 = UBound(a, 2)

is giving run time error 13.
pls someone check it and help me solving this issue.

Sub RefineData3()
Dim i As Long, j As Long, Lr As Long, LrD As Long, N As Long, vWS As Worksheet, vR As Long
Dim a As Variant, b As Variant, k As Long, uba2 As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long, vA, vA2()
 Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Result"
For i = 1 To ThisWorkbook.Sheets.Count - 1
If Sheets(i).Range("C20").Value = "TOTAL PCS" Then
Lr = Sheets(i).Range("D21").End(xlDown).Row
If Lr = Rows.Count Then GoTo Step2
Debug.Print Sheets(i).Name
LrD = Sheets("Result").Range("B" & Rows.Count).End(xlUp).Row + 1
If LrD = 2 Then
Sheets(i).Range("C17:AN" & Lr).Copy
Sheets("Result").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
Sheets(i).Range("C21:AN" & Lr).Copy
Sheets("Result").Range("A" & LrD).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Step2:
End If
Next i
If Sheets("Result").Range("H4").Value = "" Then
Sheets("Result").Range("H4").Value = Sheets("Result").Range("G4").Value
Sheets("Result").Range("G4").Value = ""
End If
Sheets("Result").Rows("2:3").Delete
For i = 11 To 1 Step -1
  Select Case Trim(Sheets("Result").Cells(2, i).Value)
   Case "TOTAL PCS", "SHRINKAG", "Width", "Shade", "Balance", ""
    Sheets("Result").Columns(i).Delete
   End Select
Next i
With Sheets("Result")
.Range("D2:AN2").Value = .Range("D1:AN1").Value
.Rows("1").Delete
LrD = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("A1:AN" & LrD).AutoFilter Field:=3, Criteria1:="<>"
  .Range("A1:AN" & LrD).SpecialCells(xlCellTypeVisible).Copy
  .Range("A" & LrD + 1).Select
   ActiveSheet.Paste
  .Range("A1:AN" & LrD).AutoFilter
  .Rows("1:" & LrD).Delete
  .Columns(3).Delete
  
  a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column).Value
  uba2 = UBound(a, 2)
  ReDim b(1 To UBound(a) * (uba2 - 2), 1 To 4)
  For i = 2 To UBound(a)
    For j = 3 To uba2
      If Len(a(i, j)) > 0 Then
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 2)
        b(k, 3) = a(1, j)
        b(k, 4) = a(i, j)
      End If
    Next j
  Next i
  Lr = .Range("A" & Rows.Count).End(xlUp).Row
  LrD = .Cells(1, Columns.Count).End(xlToLeft).Column
  Range(.Cells(1, 1), .Cells(Lr, LrD)).ClearContents
  .Range("A" & Rows.Count).End(xlUp).Resize(, 4).Value = Array("QTY", "CUT #", "Size", "Bundle")
  .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 4).Value = b
    
    vR = .Cells(Rows.Count, 4).End(xlUp).Row
    vSum = Application.Sum(.Range("D2:D" & vR))
     ReDim Preserve vA2(1 To vSum, 1 To 4)
    vA = .Range("A2:D" & vR)
      For vN = 1 To vR - 1
        For vN2 = 1 To vA(vN, 4)
          vC = vC + 1
           For vN3 = 1 To 4
             vA2(vC, vN3) = vA(vN, vN3)
           Next vN3
        Next vN2
      Next vN
 End With
       
  vC = 1
   For vN = 1 To vSum - 2
    vA2(vN, 4) = vC
     If vA2(vN + 1, 2) = vA2(vN, 2) Then
      vC = vC + 1
      vA2(vN + 1, 4) = vC
     Else
      vA2(vN + 1, 4) = 1
      vC = 1
     End If
   Next vN
 Sheets.Add(After:=Sheets(Sheets.Count)).Name = "FinalResult"
   With ActiveSheet
        Sheets("Result").Range("A1:D1").Copy .Range("A1:D1")
       .Cells(2, 1).Resize(vSum, 4) = vA2
  End With
Application.ScreenUpdating = True
End Sub

Thanks in anticipation.