Code to "snake" columns is losing all formatting

[youngeli]

I have the following code which I found and adapted for my uses. It is designed to take a set number of columns and split them at a set number of rows, and then put the values in those cells that were below the cutoff point to the right of the original columns. I'm using this because I have a long column that I need to automatically display on a single page. The issue is that the formatting I have set to the original column is being lost after the "snaking" occurs. Is there a way to adapt this code further so that it Copy and Pastes rather than does .value = .value?

If that is not possible, how do I go back after the "snaking" and set all the non-integer values in my sheet to have a larger and bold font? Thanks!

Dim outSheet As Worksheet
Dim inSheet As Worksheet
Dim outCursor As Range
Dim lRow As Long, lastRow As Long
Dim maxRows As Long, repeatAtTop As Boolean
Dim numColumns As Long


    maxRows = 32
    numColumns = 3
    
    
        lastRow = Cells.Find(What:="*", After:=[A1], _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row

        Set inSheet = ActiveSheet
        Set outSheet = ActiveSheet ' this is where the output will go
        Set outCursor = outSheet.Range("A1")
        
        
        For lRow = 1 To lastRow
        
            outCursor.Resize(1, numColumns).Value2 = Range(inSheet.Cells(lRow, 1), inSheet.Cells(lRow, numColumns)).Value2 'copy the first two columns to output page
            
            If (lRow - 1) Mod maxRows = 0 And lRow > 1 Then 'every 60 rows, generate new set of columns - so shift outCursor to the right, and back up to the top!
                Set outCursor = outCursor.Offset(0, numColumns).End(xlUp)
            Else
                Set outCursor = outCursor.Offset(1, 0) 'ready for next row of input
            End If
        Next lRow
Range("A33:A10000").Clear
Range("B33:B10000").Clear

 

[ukmikeb]

Hi

Try this for the loop :-

        For lRow = maxRows + 1 To lastRow Step maxRows
        
             inSheet.Range([A1]).Offset(Int(lRow / maxRows) * maxRows).Resize(maxRows, numColumns).Copy _
                         Destination:=outSheet.Range([A1]).Offset(, Int(lRow / maxRows) * numColumns)

        Next lRow

hth

Btw your code didn't copy row 33!