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

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

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,471
Messages
5,408,445
Members
403,206
Latest member
DeB395

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