Forum Discussion

Tiffany Eckman-Latchum's avatar
Tiffany Eckman-Latchum
Copper Contributor
Jul 19, 2018

copy data from one sheet to another

Question..I have a sheet with multiple information on one sheet and I need to separate the data onto other sheets but don't want to have to copy and paste 139 times.  Any suggestions?? How to do this...
excel
Lorenzo Kim's avatar
Lorenzo Kim
Bronze Contributor
Jul 20, 2018

Ms Tiffany

I am not an Excel GURU - but I learned from this Forum many things and below is what I have learned so far from the assistance of many gracious men of this forum.

I made a SUB (pls see below) for you to test. (always make a backup copy of your data - just in case).

copy your data to another workbook and try it. 

I am assuming that all the records has 15 rows with columns A to E.

and there is no gap between rows of records.

 

In case the following does not help, there are many MVP's here to help you..

HTH

 

Sub AddSheetAndCopy()
    Dim i As Long, arow As Long, erow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    arow = 1
    erow = 15
    For i = 1 To 139
        Range(("A" & arow) & ":" & ("E" & erow)).Copy
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.name = "Newsheet" & Trim(Str(i))
        Range("A1").Select
        ActiveSheet.Paste
        arow = arow + 15
        erow = erow + 15
        ws.Select
    Next i
End Sub

 

Lorenzo Kim's avatar
Lorenzo Kim
Bronze Contributor
Jul 20, 2018

I think this is a better SUB - can be any number of data other than 139

 

Sub AddSheetAndCopy()
    Dim i As Long, arow As Long, erow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Lastrow = Lastrow / 15
    arow = 1
    erow = 15
    For i = 1 To Lastrow
        Range(("A" & arow) & ":" & ("E" & erow)).Copy
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.name = "Newsheet" & Trim(Str(i))
        Range("A1").Select
        ActiveSheet.Paste
        arow = arow + 15
        erow = erow + 15
        ws.Select
    Next i
End Sub

 

Resources