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
921
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
921
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
921
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
921
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,457
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
921
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,485
Messages
5,408,546
Members
403,214
Latest member
Kurtrkelly

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top