Copy every 4 cells and paste it into in the next row till there is a empty cell

S

sairam89

New Member
Joined
Jun 13, 2018
Messages
4
Hi
I am a newbie to macros and i want to use macro to copy and paste the table data

Please look into the below tables and you will have a clear picture of what kind of result i am looking for

Input
[TABLE="width: 832"]
<colgroup><col style="width:48pt" width="64" span="13"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]User
[/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[/TR]
[TR]
[TD="class: xl63"]A
[/TD]
[TD="class: xl64"]101[/TD]
[TD="class: xl64"]106[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]106[/TD]
[TD="class: xl64"]201[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]201[/TD]
[TD="class: xl64"]101[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]1[/TD]
[/TR]
[TR]
[TD="class: xl63"]B
[/TD]
[TD="class: xl64"]201
[/TD]
[TD="class: xl64"]203[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]203[/TD]
[TD="class: xl64"]106[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]1
[/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
</tbody>[/TABLE]

Output
[TABLE="width: 320"]
<colgroup><col style="width:48pt" width="64" span="5"> </colgroup><tbody>[TR]
[TD="width: 64"][/TD]
[TD="class: xl65, width: 64"]O[/TD]
[TD="class: xl65, width: 64"]D[/TD]
[TD="class: xl65, width: 64"]M[/TD]
[TD="class: xl65, width: 64"]T
[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="class: xl65"]101[/TD]
[TD="class: xl65"]106[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: xl65"]106[/TD]
[TD="class: xl65"]201[/TD]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: xl65"]201[/TD]
[TD="class: xl65"]101[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]1[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD="class: xl65"]201[/TD]
[TD="class: xl65"]203[/TD]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: xl65"]203[/TD]
[TD="class: xl65"]106[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]1
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
</tbody>[/TABLE]
Thanks in advance
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Welcome to the MrExcel board!

Try this in a copy of your workbook.

Code: 
Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, r As Long, uba2 As Long
  
  a = Range("A1").CurrentRegion.Value
  uba2 = UBound(a, 2)
  ReDim b(1 To (uba2 - 1) / 4 * (UBound(a, 1) - 1), 1 To 5)
  For i = 2 To UBound(a)
    b(r + 1, 1) = a(i, 1)
    For j = 2 To uba2 Step 4
      r = r + 1
      For k = 1 To 4
        b(r, k + 1) = a(i, j + k - 1)
      Next k
    Next j
  Next i
  With Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(, 5)
    .Value = Range("A1").Resize(, 5).Value
    .Offset(1).Resize(UBound(b)).Value = b
  End With
End Sub

My data & results:


Book1
ABCDEFGHIJKLM
1UserODMTODMTODMT
2A101106111062012220110111
3B2012032220310611
4
5UserODMT
6A10110611
710620122
820110111
9B20120322
1020310611
Rearrange
 
Upvote 0
sairam89 said:
How can I skip blank rows in this table while rearranging
Click to expand...
See if this is it. (Red = deletions, blue = additions)
Rich (BB code): 
Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, r As Long, uba2 As Long
  
 <del> a = Range("A1").CurrentRegion.Value</del>
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, Cells(1, Columns.Count).End(xlToLeft).Column).Value
  uba2 = UBound(a, 2)
  ReDim b(1 To (uba2 - 1) / 4 * (UBound(a, 1) - 1), 1 To 5)
  For i = 2 To UBound(a)
    If a(i, 1) <> "" Then
      b(r + 1, 1) = a(i, 1)
      For j = 2 To uba2 Step 4
        r = r + 1
        For k = 1 To 4
          b(r, k + 1) = a(i, j + k - 1)
        Next k
      Next j
    End If
  Next i
  With Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(, 5)
    .Value = Range("A1").Resize(, 5).Value
    .Offset(1).Resize(UBound(b)).Value = b
  End With
End Sub
 
Upvote 0
Blank rows are still there problem is not resolved

Input

[TABLE="width: 832"]
<colgroup><col width="64" span="13" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"] [/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[TD="class: xl64, width: 64"]O[/TD]
[TD="class: xl64, width: 64"]D[/TD]
[TD="class: xl64, width: 64"]M[/TD]
[TD="class: xl64, width: 64"]T[/TD]
[/TR]
[TR]
[TD="class: xl65"]S[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"]B[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[/TR]
[TR]
[TD="class: xl65"]C[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"]V[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[/TR]
[TR]
[TD="class: xl65"]D[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[TD="class: xl64"]30[/TD]
[TD="class: xl64"]28[/TD]
[TD="class: xl64"]1[/TD]
[TD="class: xl64"]2[/TD]
[/TR]
</tbody>[/TABLE]

Output
[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]
[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"]O[/TD]
[TD="class: xl65, width: 64"]D[/TD]
[TD="class: xl65, width: 64"]M[/TD]
[TD="class: xl65, width: 64"]T[/TD]
[/TR]
[TR]
[TD="class: xl65"]S[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"]B[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]C[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"]V[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]D[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65"]30[/TD]
[TD="class: xl65"]28[/TD]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]2[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
sairam89 said:
Blank rows are still there problem is not resolved
Click to expand...
Sorry, you didn't previously specify which table to skip blank rows in and I guessed the original table, not the result table. :)

Try this (which should skip blanks in either table based on your sample data)

Code: 
Sub Rearrange_v3()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, r As Long, uba2 As Long
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, Cells(1, Columns.Count).End(xlToLeft).Column).Value
  uba2 = UBound(a, 2)
  ReDim b(1 To (uba2 - 1) / 4 * (UBound(a, 1) - 1), 1 To 5)
  For i = 2 To UBound(a)
    If a(i, 1) <> "" Then
      b(r + 1, 1) = a(i, 1)
      For j = 2 To uba2 Step 4
        If a(i, j) = "" Then Exit For
        r = r + 1
        For k = 1 To 4
          b(r, k + 1) = a(i, j + k - 1)
        Next k
      Next j
    End If
  Next i
  With Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(, 5)
    .Value = Range("A1").Resize(, 5).Value
    .Offset(1).Resize(UBound(b)).Value = b
  End With
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
295
Skyybot
Skyybot
P
  • Question Question
How to find till which row the marco executed. It stopped at some random row without any error and unable to identitfy at what row it has been stopped
Replies
3
Views
187
FormR
FormR
C
  • Question Question
Excel Formula to keep records of drawn cards
Replies
3
Views
281
Cquake
C
youbitto
  • Solved
Copy paste from multiple Excel and Csv files to another excel file VBA
Replies
2
Views
199
youbitto
youbitto
D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
570
smozgur
smozgur

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top