Thread: Merge Every 3 Rows into 1 row Thanks: 0 Likes: 0

1. Merge Every 3 Rows into 1 row

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.  Reply With Quote

2. Re: Merge Every 3 Rows into 1 row

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  Reply With Quote

3. Re: Merge Every 3 Rows into 1 row

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.  Reply With Quote

4. Re: Merge Every 3 Rows into 1 row

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.  Reply With Quote

5. Re: Merge Every 3 Rows into 1 row

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?  Reply With Quote

6. Re: Merge Every 3 Rows into 1 row

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  Reply With Quote

7. Re: Merge Every 3 Rows into 1 row

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  Reply With Quote

8. Re: Merge Every 3 Rows into 1 row

I get an error at "For i = 2 To LR Step 3"  Reply With Quote

9. Re: Merge Every 3 Rows into 1 row

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  Reply With Quote

10. Re: Merge Every 3 Rows into 1 row

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?  Reply With Quote

User Tag List

Tags for this Thread

file, output, power query, records, rows, worksheet  Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•