Merge Every 3 Rows into 1 row

sduttexcel

New Member
Joined
Mar 16, 2018
Messages
19
I have a data file of say 60,000 records and each record are up to column K. I need to combine every 3 rows as one row into a new worksheet.

Input rows will be: A2 to K2, A3 to K3 and A4 to K4

Output will be on a new worksheet will be from:
A2 to AG2

This formula will be for entire worksheet.

There for the quantity in the output file will be 20,000 records.
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

kweaver

Well-known Member
Joined
May 8, 2018
Messages
919
Office Version
365, 2010
Here's one way that seems to work:

Code:
Sub Copy3Rows()
Dim LR As Long, i As Integer, j As Integer
LR = Cells(Rows.Count, "G").End(xlUp).Row
j = 2
For i = 2 To LR Step 3
Sheets("New").Range("A" & j, "K" & j).Value = Sheets("Original").Range("A" & i, "K" & i).Value
Sheets("New").Range("L" & j, "V" & j).Value = Sheets("Original").Range("A" & i + 1, "K" & i + 1).Value
Sheets("New").Range("W" & j, "AG" & j).Value = Sheets("Original").Range("A" & i + 2, "L" & i + 2).Value
j = j + 1
Next i
End Sub
 

sduttexcel

New Member
Joined
Mar 16, 2018
Messages
19
I got a Debug error

For i = 2 To LR Step 3

I just copied the code you have me. Don't know what I'm doing wrong.
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
919
Office Version
365, 2010
Probably would get an error if the count from row 2 to N is not a multiple of 3.
I didn't include any error checking to confirm that.
 
Last edited:

sduttexcel

New Member
Joined
Mar 16, 2018
Messages
19
Not every time the data will be evenly divided by 3. What if I have 7,000 records. The last row will have 1 record only. Can I use Offset formula to do it?
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
919
Office Version
365, 2010
How about this adjustment?

Code:
Sub Copy3Rows()
Dim LR As Long, i As Integer, j As Integer
LR = Sheets("Original").Cells(Rows.Count, "G").End(xlUp).Row
LR = LR + (1 + (LR - 2)) Mod 3
j = 2
For i = 2 To LR Step 3
Sheets("New").Range("A" & j, "K" & j).Value = Sheets("Original").Range("A" & i, "K" & i).Value
Sheets("New").Range("L" & j, "V" & j).Value = Sheets("Original").Range("A" & i + 1, "K" & i + 1).Value
Sheets("New").Range("W" & j, "AG" & j).Value = Sheets("Original").Range("A" & i + 2, "L" & i + 2).Value
j = j + 1
Next i
End Sub
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
919
Office Version
365, 2010
I'm scratching my own head why I put "G" in this line. Change it to "A".

LR = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,452
How long does this take?
Change Sheet references as required.
Code:
Sub Maybe()
Dim i As Long, j As Long
i = 2
    For j = 2 To WorksheetFunction.RoundUp(Cells(Rows.Count, 1).End(xlUp).Row / 3, 0)
        With Sheets("Sheet3")
            .Cells(j, 1).Resize(, 11).Value = Cells(i, 1).Resize(, 11).Value
            .Cells(j, 12).Resize(, 11).Value = Cells(i + 1, 1).Resize(, 11).Value
            .Cells(j, 23).Resize(, 11).Value = Cells(i + 2, 1).Resize(, 11).Value
        End With
        i = i + 3
    Next j
End Sub
 
Last edited:

kweaver

Well-known Member
Joined
May 8, 2018
Messages
919
Office Version
365, 2010
I'll need more info as I've tried this with 6000+ rows and it works. What error did you get? How many rows are there?
 

Forum statistics

Threads
1,089,213
Messages
5,406,883
Members
403,111
Latest member
Donbozone

This Week's Hot Topics

Top