Excel rearranging data from column to row using macro [duplicate]

Question

The code should start at Cell B2 and iterate through the column, rearranging the data horizontally according to the picture (see picture description).

The for-loop works for square 1 (street address 1, zip 1 and so on)is arranged horizontally, but not for the following squares.

Help in this regard would be greatly appreciated. Many thanks.

Do While IsEmpty(Cells(iRange, 2)) = False

    For i = iRange To iLimit
        
        Cells(i, iRange).Select
        j = i
        Selection.Cut Destination:=Cells(iRange, j)
            
    Next i
        
    iRange = iRange + 6
    iLimit = iLimit + 6

Loop

You Do While loop only works until you find the first empty cell. There is an empty cell between your 2 address. I suspect that's whats causing the issue. Although it's difficult to workout what you are doing without know what the initial value of iRange is — Zac
– Zac, Commented Aug 20, 2020 at 11:07
@Zac the original value of iRange is 2. I thought that it would skip over the empty cells. — Nicolas Peyer
– Nicolas Peyer, Commented Aug 20, 2020 at 11:17
@Porcupine911 yes, partially but how would I change this solution when the paste cells change (how to automate it)? — Nicolas Peyer
– Nicolas Peyer, Commented Aug 20, 2020 at 11:19

Veegore · Accepted Answer · 2020-08-20 18:15:54Z

You don't need to do a while loop here, a for loop with an upper range of usedrange.rows.count will set the variable to be the last row with data in it (even if there's white space between data)

The code below will take the vertical data and rearrange it to be horizontal (overwriting what is there already)

It assumes that the data will always been in the same format with 1 blank row separating entries (you can tweak the counter resets if you need)

Sub RunMe()
Dim lrow As Integer
lrow = ActiveSheet.UsedRange.Rows.Count 'Last row with data (even if there's blanks)
Dim IRange As Integer
Dim j As Integer
j = 1 'We'll use this as our column counter for pasting
IRange = 1 'We'll use this as our row counter for pasting
For i = 1 To lrow
        Cells(i, 1).Cut Cells(IRange, j) 'Cut and paste
        If j = 6 Then 'If we've used up 6 columns of pasting we want to jump to the next row for pasting
            j = 1 'also reset our column counter to 1
            IRange = IRange + 1
        Else
            j = j + 1 'increase our column counter
        End If
Next i
End Sub

Collectives™ on Stack Overflow

Excel rearranging data from column to row using macro [duplicate]

1 Answer 1

1 Comment

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Linked

Related