# Merge Every 3 Rows into 1 row

#### sduttexcel

##### New Member
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.

### Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

#### kweaver

##### Well-known Member
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
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
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
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

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
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

#### sduttexcel

##### New Member
I get an error at "For i = 2 To LR Step 3"

#### jolivanes

##### Well-known Member
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
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?