Set data in consecutive rows to fit across multiple pages

[Jayamurugan]

Hi, I have data in 3 rows and multiple columns.

I want it in wrapped in 4 or 5 columns and consecutive rows to fit across multiple pages. So as not to waste papers.

Please help. Thanks in advance!

 

[Sam_D_Ben]

@Jayamurugan, How are you?
Could you verify if this script is detecting the QR code?

Sub testQrCode()
    Dim a As Worksheet, b As shape, c As shape
    Dim d As Long, e As Long, f As Long, g As Long
    Dim h As Range, i As Range

    Set a = ActiveSheet
    d = a.Cells(1, a.Columns.Count).End(xlToLeft).Column
    e = a.Cells(Rows.Count, 1).End(xlUp).Row
    f = e + 4

    For g = 1 To d Step 3
        Set h = a.Range(a.Cells(1, g), a.Cells(3, Application.Min(g + 2, d)))
        Set i = a.Cells(f, 1)

        h.Copy
        i.PasteSpecial Paste:=xlPasteValues
        i.PasteSpecial Paste:=xlPasteFormats

        For Each b In a.Shapes
            If Not Intersect(a.Cells(1, g), b.TopLeftCell) Is Nothing Then
                b.Copy
                a.Paste
                Set c = a.Shapes(a.Shapes.Count)
                With c
                    .Top = i.Top
                    .Left = i.Left
                    .LockAspectRatio = msoTrue
                End With
                a.Rows(f).RowHeight = c.Height + 5
            End If
        Next b

        f = f + 3
    Next g

    Application.CutCopyMode = False
    
End Sub

 

[Jayamurugan]

@Jayamurugan, How are you?
Could you verify if this script is detecting the QR code?

Sub testQrCode()
    Dim a As Worksheet, b As shape, c As shape
    Dim d As Long, e As Long, f As Long, g As Long
    Dim h As Range, i As Range

    Set a = ActiveSheet
    d = a.Cells(1, a.Columns.Count).End(xlToLeft).Column
    e = a.Cells(Rows.Count, 1).End(xlUp).Row
    f = e + 4

    For g = 1 To d Step 3
        Set h = a.Range(a.Cells(1, g), a.Cells(3, Application.Min(g + 2, d)))
        Set i = a.Cells(f, 1)

        h.Copy
        i.PasteSpecial Paste:=xlPasteValues
        i.PasteSpecial Paste:=xlPasteFormats

        For Each b In a.Shapes
            If Not Intersect(a.Cells(1, g), b.TopLeftCell) Is Nothing Then
                b.Copy
                a.Paste
                Set c = a.Shapes(a.Shapes.Count)
                With c
                    .Top = i.Top
                    .Left = i.Left
                    .LockAspectRatio = msoTrue
                End With
                a.Rows(f).RowHeight = c.Height + 5
            End If
        Next b

        f = f + 3
    Next g

    Application.CutCopyMode = False
   
End Sub

I am extremely sorry Mr. Sam_D_Ben. I made mistake by posting Google sheets screenshot. Due to absence of IMAGE function in Excel, I used Google sheets to generate QR code. However, I tried in Excel 2003 and 365 without QR code. Your code worked excellently and wrapped data in three columns.
I need QR code also. So, could you please change the VBA script suggested by you to Google Apps Script wrapped in to six columns?