code for inserting, copying/pasting data (advanced)

hinchah · May 15, 2003

i have about 11,000 rows of data in worksheet 'project'. the data is located in columns A through L.
within the 11,000 rows, there are approx. 150 changes in the data. the data changes in column A.
here is what i would like to write.....

for every change in A2, insert a worksheet, and rename the worksheet with the data contained in A2. copy and paste all the data from A2:L2 to A53:L53(example)into the newly created worksheet. only copy an paste the data until there is another change in Column A.

when there is another change in column A, go back to the 'project' worksheet and complete the process all over again, starting where the last copy and paste left off. Also, for every new worksheet inserted and named I always want to insert the header row from the 'project' worksheet which contains the column titles(A:L).

in the end.... i will hopefully have approx. 150 newly inserted and named worksheets within the one workbook, each containing different amounts of data, and all adding up to the 'project' worksheet.

Andrew Poulsom · May 16, 2003

Try this:

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim ShNew As Worksheet
    Dim FName As String
    Application.ScreenUpdating = False
'   *** Change Sheet name to suit ***
    Set Sh = Worksheets("project")
    Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A1:A" & Sh.Range("A65536").End(xlUp).Row)
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Sh.Cells.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
        Rng.AutoFilter
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

hinchah · May 16, 2003

works great, but i am getting an error after about 15 inserted and copied worksheets....message = 'not enough memory'

any suggestions/ideas??

thanks for the help.

Andrew Poulsom · May 16, 2003

My fault - Sh.Cells.SpecialCells selects the whole worksheet. I have changed it to Rng.SpecialCells (and removed an unused variable). It's a lot faster!

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim ShNew As Worksheet
    Application.ScreenUpdating = False
'   *** Change Sheet name to suit ***
    Set Sh = Worksheets("project")
    Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A1:A" & Sh.Range("A65536").End(xlUp).Row)
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
        Rng.AutoFilter
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

hinchah · May 16, 2003

real fast, but now its only copying and pasting the data from Column A, and i need all the data from columns A:L, like the first code you gave...

thanks in advance.

Andrew Poulsom · May 16, 2003

I should have known there was a reason for using Sh.Cells. I have expanded the range to include columns A:L.

Code:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim ShNew As Worksheet
    Application.ScreenUpdating = False
'   *** Change Sheet name to suit ***
    Set Sh = Worksheets("project")
    Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A1:L" & Sh.Range("A65536").End(xlUp).Row)
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
        Rng.AutoFilter
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

hinchah · May 16, 2003

perfect. greatly appreciated.

surkdidat · Jul 31, 2012

Is it possible to amend this so the master sheet (in my case called "invoice") can look at column A. This will either be blank, or contain a month. (The month column has a formula in it). The "invoice" sheet would have columns A through to M. I have tried to amend the above code replacing "project" with "invoice" and A:L to A:M/ This brings up an error, when I debug, it does not like "invoice". I have copied this code into the macro on the "invoice" page, and when i click on run is when I get this message up. Am i doing this right? Can it have a command button, or better still work automatically?

code for inserting, copying/pasting data (advanced)

hinchah

Board Regular

Excel Facts

Andrew Poulsom

MrExcel MVP

hinchah

Board Regular

Andrew Poulsom

MrExcel MVP

hinchah

Board Regular

Andrew Poulsom

MrExcel MVP

hinchah

Board Regular

surkdidat

Well-known Member

Similar threads

Forum statistics

Share this page

code for inserting, copying/pasting data (advanced)

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock