Copy a vertical list and paste horizontally with offsets in a loop

Question

I want to copy the list PoSend.Range("B" & a).Value (which is a list until the last row), horizontally on sheet "Exprt" with an offset of three between each value

Dim Exprt As Worksheet
Set Exprt = ThisWorkbook.Sheets("PO&Drawings")

For a = 9 To PoSend_LR

    PoSend_LR = PoSend.Range("B" & Rows.Count).End(xlUp).row
    Dim a As Integer
    Dim k As Integer

    POinput = Left(PoSend.Range("B9"), Len(PoSend.Range("B9")) - 14)

    If Not IsEmpty(PoSend.Range("B9").Value) Then
    
    End If

    For a = 9 To PoSend_LR

        Dim mylink As String
        FileNameLong = PoSend.Range("B" & a).Value
        FileName = Left(FileNameLong, Len(FileNameLong) - 16)
        FullPath = PoSend.Range("E7") & "\" & FileName & "\" & FileNameLong
    
        Exprt.Range("B7").Offset(0, 3).Value = FileName

Filenameis a string which contains each line from my PoSend.Range("B" & a).Value list. I'd like to paste each filename in Exprt.Range("B7").Value with an offset of three per pasted value.

Answer 1

Best guess:

Sub Tester()

    Dim Exprt As Worksheet, PoSend As Worksheet, c As Range, cDest As Range
    Dim Filename As String, FullPath As String, FileNameLong As String
    
    Set Exprt = ThisWorkbook.Sheets("PO&Drawings")
    Set PoSend = ThisWorkbook.Sheets("PO Send") 'eg...
    
    Set cDest = Exprt.Range("B7") 'starting destination
    'loop down from row 9 to last row in ColB
    For Each c In PoSend.Range("B9", PoSend.Cells(Rows.Count, "B").End(xlUp)).Cells
        FileNameLong = c.Value
        If Len(FileNameLong) > 0 Then
            Filename = Left(FileNameLong, Len(FileNameLong) - 16)
            FullPath = PoSend.Range("E7") & "\" & Filename & "\" & FileNameLong
            cDest.Value = FullPath
            Set cDest = cDest.Offset(0, 3) 'next destination cell
        End If
    Next c
    
End Sub