Macro that copies every 600 rows and paste data in new spreadsheet

**Bealey** · 03-27-2012, 01:45 AM

I am trying to write a macro that will copy data stored in every 600 rows to a new spreadsheet - i have tried to upload a trimmed version of the spreadsheet but the up loader is not working for me!

The spreadsheet contains 450,000 rows of data; column A is time, column B is signal response.

i would like to write a macro that copies every 600 rows of data (A1:B600, A601:B1200, A1201:B1800, etc) to a new spreadsheet tab.

For example:
sheet 1 - select A1:B600 (copy), sheet 2 A1 (paste)
sheet 1 - select A601:B1200 (copy), sheet 2 C1 (paste)
sheet 1 - select A1201:B1800 (copy), sheet 2 E1 (paste)
ect....for every 600 rows until all data is copied.

I have limited experience with excel macros - the only way i know how to do this is by writing code for action. I was hoping that someone could help write code that is more automated

thanks in advance

**Paul** · 03-27-2012, 01:56 AM

Hi Bealey, welcome to the forum.

The following macro should move your data to sheet2 as requested.

Sub movedata()
Dim lastrow As Long, i As Long, c As Long
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
c = 1

Application.ScreenUpdating = False
For i = 1 To lastrow Step 600
    With Sheets("Sheet2")
        .Range(.Cells(1, c), .Cells(600, c + 1)).Value = _
        Sheets("Sheet1").Range("A" & i & ":B" & i + 599).Value
    End With
    c = c + 2
Next i
Application.ScreenUpdating = True
End Sub

Hope it helps!

**jolivanes** · 03-27-2012, 03:05 AM

Would something like this do it (Try on a copy of your workbook)

Change "Sheet2" in this code to the Sheetname with the 450,000 rows of info

Sub TryThis()
    Dim LR As Double
    Dim TS As Double
    Dim i As Double, ii As Double, k As Double
    Application.ScreenUpdating = False
    LR = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    TS = WorksheetFunction.RoundUp(LR / 600, 0)
    i = 1
    ii = 600
    For k = 1 To TS
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = i & " - " & ii
        Sheets("Sheet2").Range("A" & i, Sheets("Sheet2").Range("B" & ii)).Copy Sheets(Sheets.Count).Range("A1")
        i = i + 600
        ii = ii + 600
    Next k
    Application.ScreenUpdating = True
End Sub

**Bealey** · 03-27-2012, 07:58 AM

Thanks Paul- the macro you wrote worked a dream....I must say the code was more complicated than envisaged, especially for a macro novice like me.

I am now looking for a macro to calculate the median of each column, then subtract the median from each data point within the column and present the new data points in a third spreadsheet....can you give me any pointers?

Again - your assistance is much appreciated

**JBeaucaire** · 03-27-2012, 09:38 AM

Bealey, sounds like THIS thread is resolved. Best to post new completely new questions in new threads.

If that takes care of your original titled need, please click Thread Tools above your first post and mark this thread as SOLVED.