Repeat VBA code to next row

[edwardvolpe2012]

Hi all,

I'm creating a VBA code to transpose some information for me.

Breakdown of the data
Column A is a code or SKU
C1:E1 are production dates
C2:A4 are volumes

Ultimately the code I've written below tells me when production is starting for each code and populates the date of production start in column B
So for example if you look at row 2 the code will find the first cell with data in it, jump to the top row, pull the date, and place it in column B
I've gotten the code to work but I over 200 rows to apply this too (I've already done this and encountering compile error if I go over a 250 rows).
Instead of writing code for the next row / iteration 200 + times, I want to know if there is a way to repeat the code to each row.
I've been trying loop functions but cant figure it out, any help would be greatly appreciated.

Before Macro Run

End Result

For example:

Sub Macro1()

Range("A2").Select
Selection.End(xlToRight).Select
ActiveCell.EntireColumn.Select
Selection.End(xlUp).Select
Selection.Copy
Range("B2").Select
ActiveSheet.Paste


Range("A3").Select
Selection.End(xlToRight).Select
ActiveCell.EntireColumn.Select
Selection.End(xlUp).Select
Selection.Copy
Range("B3").Select
ActiveSheet.Paste

Range("A4").Select
Selection.End(xlToRight).Select
ActiveCell.EntireColumn.Select
Selection.End(xlUp).Select
Selection.Copy
Range("B4").Select
ActiveSheet.Paste


End Sub

 

[mumps]

Try:

Sub PullDate()
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long
    v = Range("A1").CurrentRegion.Value
    For r = 2 To UBound(v)
        For c = 3 To UBound(v, 2)
            If v(r, c) <> "" Then
                Range("B" & r) = v(1, c)
                Exit For
            End If
        Next c
    Next r
    Application.ScreenUpdating = True
End Sub

 

[edwardvolpe2012]

OMG That worked perfectly!!!!
Thank you so much!!!

 

[mumps]

You are very welcome.

 

[igold]

How about this...

Sub Columns()

    Dim arr, arr2
    Dim i As Long, x As Long
    Dim lastC
    
    lastC = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    x = 1
    arr = Range(Cells(1, 3), Cells(1, lastC))
    ReDim arr2(1 To UBound(arr, 2), 1 To 1)
    For i = UBound(arr2) To 1 Step -1
        arr2(i, 1) = arr(1, x)
        x = x + 1
    Next
    Range("B2").Resize(UBound(arr2)) = arr2
        
End Sub