Save CSV As XLSX with Same Name & Directory

[Philip1957]

Greetings,
I have the following code which converts list data into tabular data that can be used as a lookup table. This macro resides in my Personal.xlsb. Everything works fine except for the final save as sub. It wants to save the file in my OneDrive root rather than the directory where the original csv file is located. This directory can change so I can't specify a fixed path for the saved file. If there is no save location specified, shouldn't it default to the path where the original file is located?

Option Explicit

Sub Ref_Desig_Tab()

Application.ScreenUpdating = False

'-----START TIMER-----
Dim StartTime As Double
Dim TimeTaken As String
StartTime = Timer

File_Prep
Transpose
Save_As_XLSX

'------ END TIMER------
TimeTaken = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Running time was " & TimeTaken & " (hours, minutes, seconds)"

Application.ScreenUpdating = True

End Sub

Private Sub File_Prep()

    ActiveSheet.Name = "Orig"
    ActiveSheet.Range("D:D").Copy Range("I:I")
    ActiveSheet.Range("F:F").Copy Range("J:J")
    ActiveSheet.Range("C:C").Copy Range("K:K")
    
    'Remove Spaces
    Columns("K:K").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
    ' Text to Columns
    Columns("K:K").Select
    Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    
    Sheets.Add.Name = "Tabular"
    Worksheets("Tabular").Activate
    Range("A1").Value = "Ref Desig"
    Range("B1").Value = "P/N"
    Range("C1").Value = "Desc"
    Range("A1:C1").Font.Bold = True
    Range("A1:C1").HorizontalAlignment = xlCenter
    
    
End Sub  'File_Prep
Private Sub Transpose()
Dim copysheet As Worksheet
Dim pastesheet As Worksheet
Dim NumRows As Variant
Dim rw As Long
Dim lCol As Long
Dim lrowa As Long

rw = 2
Set copysheet = Worksheets("Orig")
Set pastesheet = Worksheets("Tabular")


    copysheet.Activate
    

    ' Set numrows = number of rows of data.
    NumRows = copysheet.UsedRange.Rows.Count

    ' Establish "For" loop to loop "numrows" number of times.
    For rw = 2 To NumRows

     'Copy & Paste Ref Desig Transposed
    lCol = Cells(rw, Columns.Count).End(xlToLeft).Column
    copysheet.Range(Cells(rw, 11), Cells(rw, lCol)).Copy
    pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
    Application.CutCopyMode = False

    ' Copy & paste P/N & description.
    copysheet.Range(Cells(rw, 9), Cells(rw, 10)).Copy
    pastesheet.Activate
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    lrowa = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    Range(ActiveCell, Range("A" & Rows.Count).End(xlUp).Offset(, 1)).Resize(, 2).FillDown
    
    
    copysheet.Activate
    
    
    rw = rw + 1
    
    Next

End Sub  'Transpose

Private Sub Save_As_XLSX()

    ActiveWorkbook.SaveAs FileFormat:=51

End Sub  'Save_As_XLSX

I'm probably missing something obvious or simple

Any assistance with this would be appreciated.

Thanks in advance,
~ Phil

 

[Philip1957]

Thank you both.

Joe4's edited line did the trick. I was assigning the variable and then trying to trim the variable and was having all kinds of trouble.
I also did not realize that designating the file format as 51 didn't add the extension and I saw the error Jon mentions above several time.

Thanks again! Every visit to Mr.Excel is a learning experience.

~ Phil