Inserting/Copy rows, Transpose vba HELP

Public Sub doCustomTranspose()
   
   Dim iLastHeadCol        As Integer
   Dim iRepeatFactor       As Integer
   Dim lLastRow            As Long
   Dim lRow                As Long
   Dim sSheet              As String
   Dim lLastCol            As Long
   Dim iTranColStart       As Long
   
   iLastHeadCol = 35   
   sSheet = "Sheet1"

   lRow = 2
   With Sheets(sSheet)
      lLastRow = getItemLocation("*", .Cells)
      If lLastRow < lRow Then Exit Sub
      lLastCol = getItemLocation("*", .Rows(1), , , False)
      If (iLastHeadCol >= lLastCol) Then Exit Sub
      iRepeatFactor = lLastCol - iLastHeadCol - 1
      Application.CutCopyMode = False
      iTranColStart = iLastHeadCol + 1
      .Columns(iTranColStart).Insert
      .Columns(iTranColStart).Insert
      iTranColStart = iTranColStart + 2
      lLastCol = lLastCol + 2
      Do While lLastRow >= lRow
         If (iRepeatFactor > 0) _
         Then
            .Rows(lRow + 1 & ":" & lRow + iRepeatFactor).Insert
            lLastRow = lLastRow + iRepeatFactor
            Application.CutCopyMode = False
            .Range(.Cells(lRow, 1), .Cells(lRow, iLastHeadCol)).Copy
            .Range(.Cells(lRow + 1, 1), .Cells(lRow + iRepeatFactor, iLastHeadCol)).PasteSpecial
            Application.CutCopyMode = False
         End If
         .Range(.Cells(1, iTranColStart), .Cells(1, lLastCol)).Copy
         .Cells(lRow, iLastHeadCol + 1).PasteSpecial Transpose:=True
         .Range(.Cells(lRow, iTranColStart), .Cells(lRow, lLastCol)).Copy
         .Cells(lRow, iLastHeadCol + 2).PasteSpecial Transpose:=True
         Application.CutCopyMode = False
         lRow = lRow + iRepeatFactor
Next_lRow:
         lRow = lRow + 1
      Loop
      .Range(.Cells(1, iTranColStart), .Cells(1, lLastCol)).EntireColumn.Delete
   End With
End Sub


Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                
   'find the first/last row/column  within a range for a specific string
   
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
      
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
      
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
      
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function