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