VBA looping for 4 columns down to three columns-CodePudding

Working with the below code but for the life of me I can't figure this out. Currently it is set up to have 4 columns and then wrap around. I need to have only three columns.

I need image 1 to look like image 2.

Image 1

Image 2

Image 3

Option Explicit

Sub Price_Tags()
    Dim src As Worksheet    'the source worksheet
    Dim dest As Worksheet   'the destination worksheet
    Dim i As Long, Cols As Long
    Dim pasteRow As Long
    
Set src = Sheets("LargeTags")
Set dest = Sheets("PrintLT")

'prevent screen flicker
Application.ScreenUpdating = False

' number of columns to deal with
Cols = src.Cells(2, Columns.Count).End(xlToLeft).Column

For i = 1 To Cols Step 4
    ' where to paste to
    On Error Resume Next    'in case sheet2 is blank
    pasteRow = dest.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        Select Case pasteRow
            Case 0, 1
                pasteRow = 2
            Case Else
                pasteRow = pasteRow   2
        End Select
    On Error GoTo 0         're-instate error notification
    
    
    
    'format destination rows
    With dest.Rows(pasteRow).Cells(1)
        'row heights
        .RowHeight = 107.25                 'the item number row
        .Offset(-1).RowHeight = 51.75      'the row above the item number
        .Offset(1).RowHeight = 42       'the price row
        .Offset(2).RowHeight = 19.5        'the description row
        .Offset(3).RowHeight = 15       'the row below the description
        'item font
        
        'center everything
        .Resize(3, 4).HorizontalAlignment = xlCenter
        .Resize(3, 4).VerticalAlignment = xlCenter
    End With
    
    ' what to copy and where to paste
    With src
        .Cells(1, i).Resize(4, 4).Copy dest.Cells(pasteRow - 1, 1)
    End With
Next i
        
'format the column widths
With dest
    .Columns("A:D").ColumnWidth = 31.14
End With

Application.ScreenUpdating = True

End Sub

Sample Data

$285.93 EA, DOMESTIC SOUS-VIDE THERMAL CIRCULAT, 582/SV-96
$405.59 EA, SOUS VIDE IMMERSION CIRCULATOR, 904/630100-001

CodePudding user response：

Simply change

For i = 1 To Cols Step 4

For i = 1 To Cols Step 3

and

.Cells(1, i).Resize(4, 4).Copy dest.Cells(pasteRow - 1, 1)

.Cells(1, i).Resize(4, 3).Copy dest.Cells(pasteRow - 1, 1)

These lines define the shape of the copied data