Merge Every 3 Rows into 1 row

[sduttexcel]

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.

 

[kweaver]

Here's one way that seems to work:

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]

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]

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.

 

[sduttexcel]

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]

How about this adjustment?

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]

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]

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

 

[jolivanes]

How long does this take?
Change Sheet references as required.

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

 

[kweaver]

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?