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

I'm rather new to VBA and need some help copying the listPoSend.Range("B" & a).Value (which is a list until the last row), horizontally on sheet Exprt with an offset of 3 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

The Filename is a string whcih contains each line from my PoSend.Range("B" & a).Value list. Id like to paste each filename in Exprt.Range("B7").Value with an offset of 3 per pasted value

Thanks

CodePudding user response：

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