VBA or formula to move data in last used column to column A

[JPM]

I have a system generated report that, when imported into Excel, has financial data in the last used column of each row. However, the last column varies from row to row between columns B and P.
I created a simple macro that gets the job done, but takes a long time when the report get big, because it moves down row by row and does a copy and paste routine.
I'm looking for some faster solution, either VBA or even a formula that I can just copy down. Any ideas?
Here is my existing code:

Sub GetDataInLastColumn()
    'Purpose is to copy the data from the last used column into added column A
    Application.ScreenUpdating = False
    'Insert a new column A and highlight yellow
    Sheets("Copy").Select
    MaxRow = ActiveSheet.UsedRange.Rows.Count
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Interior.Color = 65535
    Range("A1").Select
    'Find last used column and copy data to column A. Go row by row
Repeat:
    If ActiveCell.row > MaxRow Then GoTo Done
    Application.StatusBar = "The macro is running please wait...checking row " & ActiveCell.row & " of " & MaxRow
    ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
    Cells(ActiveCell.row, "XFD").Select
    Selection.End(xlToLeft).Select
    Cost = ActiveCell.Formula
    Cells(ActiveCell.row, "A").Activate
    ActiveCell.Formula = Cost
GoTo Repeat
Done:
    Application.ScreenUpdating = True
    Application.StatusBar = ""
End Sub

Thanks

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

See if this is a bit faster.
Also wondering if you really want/need the whole of the new column coloured? This just colours the part that is populated by the rest of the code.

Sub LastCol()
  Dim a As Variant
  Dim i As Long, j As Long, uba2 As Long
 
  Application.ScreenUpdating = False
  With Sheets("Copy")
    a = .UsedRange.Value
    uba2 = UBound(a, 2)
    .Columns("A").Insert
    Intersect(.UsedRange.EntireRow, .Columns("A")).Interior.Color = 65535
    For i = 1 To UBound(a)
      j = uba2
      Do While Len(a(i, j)) = 0 And j > 1
        j = j - 1
      Loop
      a(i, 1) = a(i, j)
    Next i
    .Range("A1").Resize(UBound(a)).Value = a
  End With
  Application.ScreenUpdating = True
End Sub

 

[myall_blues]

What about something like this?

Sub GetDataInLastColumn()
    Dim lastRow As Long, i As Long, lastCol As Long
    Dim rowArr As Variant
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Interior.Color = 65535
    lastRow = Worksheets("Copy").Cells.Find("*", _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 1 To lastRow
        lastCol = Sheets("Copy").Range("B" & i).End(xlToRight).Column
        rowArr = Range(Cells(i, 2), Cells(i, lastCol))
        Range("A" & i).Value = rowArr(1, UBound(rowArr, 2))
    Next
End Sub

 

[JPM]

Peter_SSs and myall_blues, thank you both for your elegant solutions. When I timed my macro for my latest report of 1200+ rows, it took me 12.97 seconds to execute the routine. myall_blues solution got it done in 0.19 seconds and Peter_SSs in only 0.05 seconds. I certainly still have a lot to learn. Thanks for your help.