Trying to a Vlookup on Row

Trying to a Vlookup on Row

I have data that is supplied by my client in which I am checking for
duplication. I am able to return a list of values where there is such
duplication. I now want to add the store numbers that the data is
attributed to. For each value, there may be more than 2 locations. The
problem is that the data I receive has the stores going across in Row 2,
and the duplicated values are in each column.
Here is my code:
Sub Pandora()
Dim k As Integer
Dim r As Integer
Dim i As Integer
Dim strFileName As String
Dim LastCol As Long, p As Long
Dim result As String
Dim sheet As Worksheet
k = 4
r = 0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Columns("A:A").Select
Selection.Delete Shift:=xlLeft
Cells.Select
Selection.Copy
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Transpose"
ActiveSheet.Paste
Range("1:4").Select
Selection.Delete Shift:=xlUp
LastCol =
ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For p = LastCol To 1 Step -1
If WorksheetFunction.CountA(Columns(p)) = 0 Then
Columns(p).EntireColumn.Delete
End If
Next p
Columns("B:ML").EntireColumn.AutoFit
Columns("A").Insert Shift:=xlToRight
Do Until r > 65536 Or Cells(65536, k).End(xlUp).Value = ""
r = r + Range(Cells(1, k), Cells(65536, k).End(xlUp)).Rows.Count
Range(Cells(1, k), Cells(65536, k).End(xlUp)).Copy
Range("A65536").End(xlUp).Offset(1, 0)
k = k + 1
Loop
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Dupe_check"
Application.Worksheets("Transpose").Range("A:A").Copy _
Application.Worksheets("Dupe_check").Range("A:A")
Range("A1") = "ZipCart"
Range("B1") = "Dupe"
Range("B2").Formula = "=COUNTIF($A$2:$A2,A2)>1"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B7500")
Range("B2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B$7500").AutoFilter Field:=2, Criteria1:="TRUE"
Columns("A:B").EntireColumn.AutoFit
ActiveWorkbook.Sheets("Dupe_check").Activate
For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
If Worksheets(i).Name <> "Dupe_check" Then _
Worksheets(i).Delete
Next i
Find Store Values
Set sheet = ActiveWorkbook.Sheets("Dupe_check")
result = Application.WorksheetFunction.VLookup(???????)
strFileName = Format("Dupes_check") & Format(Now, " mmddyyyy") & ".xlsx"
ActiveWorkbook.SaveAs strFileName, FileFormat:=51
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I'd hate to start over with my code to make this work. Is there a way?