Need an Excel Macro to copy data to a new tab in 20 line segments

Hello,
Thank you in advance for helping me out.  My needs are to simply take a Pivot table, and copy the data into a new tab, but in 20 line segments. In the example below, please look at the row numbers in the before and after to see exactly what I'm looking for.  I'm looking to turn this:


Car Maker        Color        Stock#       Description
01  Ford Cars         Blue        563286       4 Door
02                          Green      686595       2 Door
03                          Orange   542111       SUV
04  Toyota Cars      Green    656565       2 Door
05                          Orange  545454       asdfasdf
06                           Red      323255       descriptive text
07  Honda Cars       Red    111225         4 Door




In to this:






Car Maker        Color        Stock#       Description
01  Ford Cars         Blue        563286       4 Door
02                          Green      686595       2 Door
03                          Orange   542111       SUV

21  Toyota Cars      Green    656565       2 Door
22                          Orange  545454       asdfasdf
23                           Red      323255       descriptive text

41  Honda Cars       Red    111225         4 Door



Please let me know if you need additional details and thank you so much for helping.
Regards,
Tod
tkeifferAsked:
Who is Participating?
 
jeveristConnect With a Mentor Commented:
Tod,

OK, that's a little different but still doable.  Try this:

Sub CopyPivotData()
Dim ws As Worksheet, ws_new As Worksheet, pt As PivotTable, rng As Range, cel As Range, rngcpy As Range, irow As Long, i As Long

Application.DisplayAlerts = False

Set ws = ActiveSheet
Set ws_new = Worksheets.Add

If ws.PivotTables.Count < 1 Then
    MsgBox "No PivotTables found on ActiveSheet.  Exiting routine.", vbInformation
    Exit Sub
End If

Set pt = ws.PivotTables(1)
irow = pt.RowRange.Row - pt.TableRange1.Row + 1
Set rng = pt.TableRange1.Offset(irow).Resize(pt.TableRange1.Rows.Count - irow)
ws.Rows(rng.Row - 1).Copy
ws_new.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

Set cel = rng.Cells(1)
irow = 2

i = rng.Row

For Each cel In rng.Columns(2).Cells
    If (cel.Value <> cel.Offset(1).Value And cel.Offset(1).Value <> "" And cel.Row <> rng.Row) Or cel.Row = rng.Cells(rng.Cells.Count).Row Then
        Set rngcpy = Range(rng.Columns(2).Cells(i - rng.Row + 1), cel).Offset(0, -1).Resize(ColumnSize:=rng.Columns.Count)
        rngcpy.Copy Destination:=ws_new.Cells(irow, "A")
        If ws_new.Cells(irow, "A") = "" Then
            ws_new.Cells(irow, "A") = ws_new.Cells(irow, "A").End(xlUp)
        End If
       
        ws_new.Cells(irow, "A").Resize(ws_new.Cells(ws_new.Rows.Count, "A").Offset(0, 2).End(xlUp).Row - irow + 1, 2) = ws_new.Cells(irow, "A").Resize(1, 2).Value
       
        i = cel.Offset(1).Row
        irow = irow + 20
    End If
Next cel

ws_new.UsedRange.SpecialCells(xlCellTypeLastCell).EntireRow.Delete ' Remove Grand Total row
ws_new.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple

Application.DisplayAlerts = True
Application.Goto ws_new.[A1]

End Sub

Jim
0
 
jeveristCommented:
Hi Tod,

If your PivotTable does not have any Total rows (like your example) then try this routine:

Sub CopyPivotData()
Dim ws As Worksheet, ws_new As Worksheet, pt As PivotTable, rng As Range, cel As Range, rngcpy As Range, irow As Long

Set ws = ActiveSheet
Set ws_new = Worksheets.Add

If ws.PivotTables.Count < 1 Then
    MsgBox "No PivotTables found on ActiveSheet.  Exiting routine.", vbInformation
    Exit Sub
End If

Set pt = ws.PivotTables(1)
Set rng = pt.TableRange1

Set cel = rng.Columns(1).Cells(2)
irow = 1

Do While cel.Row < rng.Rows.Count + rng.Row - 1
    Set rngcpy = Range(cel, cel.End(xlDown).Offset(-1)).Resize(ColumnSize:=rng.Columns.Count)
    rngcpy.Copy Destination:=ws_new.Cells(irow, "A")
   
    Set cel = cel.End(xlDown)
    irow = irow + 20
Loop

End Sub

Let me nkow how this works for you.

Jim
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
tkeifferAuthor Commented:
Hi Jim,
Thank you very much for helping me out.  Would there be a way for this code to work on data that is not in a pivot table?  I will be moving select content from a pivot into a new sheet rather then run the procedure on the entire pivot table.  Therefore I would prefer it to run just analyzing columns A through D.

The dataset could be of any size to answer your Total rows question.
Thanks again for all your help.
Tod
0
 
tkeifferAuthor Commented:
I kind of screwed this question up.  What my situation is like is this.  The pivot actually looks more like the one below.  The data I'm interested in moving is only the Car Maker.  The Car Maker is organized by ID.  I can't take ID out of the pivot table because then it will combine all the Car makers together.  In the example below, If you took ID out of the Pivot, the Ford cards would be combined into 1 section.  I need it to be separate.

So, I was just going to copy the text from Car Maker, Color, Stock# and Description into a new sheet, and run a macro that does as I described above.  Does that make sense?  I'm sorry for the confusion. - T

       ID       Car Maker        Color        Stock#       Description
01   A2         Ford Cars         Blue        563286       4 Door
02                                       Green      686595       2 Door
03                                      Orange   542111       SUV
04                 Toyota Cars      Green    656565       2 Door
05                                     Orange  545454       asdfasdf
06                                      Red      323255       descriptive text
07   A3         Honda Cars       Red    111225         4 Door
......
15   A6          Ford Cars      Grey     848484         Hatchback
0
 
tkeifferAuthor Commented:
Hello again Jim,
In the meantime I found a way to use this code by concatenating the first field with the second and creating another pivot table, however I found that the code was making one small mistake.  If you runt he macro on the pivot when it looks like this:

Car Maker      Color      Stock#      Description
Ford Cars      Blue      463286      4 Door
                    Green      656565      2 Door
                    Orange      98654      SUV
Honda Cars   Red      897546      e;lkjr;lkjekljrhkljhe
Chevy Cars    Black      98798798      dkfnjhklabnkl
Toyota Cars      Green      523656      2 Door
                   Orange      123456      asdf
                   Red      564654      asdfasdflk;j

Then the macro combines the two unique lines together instead of separating them by 20 lines:

Honda Cars   Red      897546      e;lkjr;lkjekljrhkljhe
Chevy Cars    Black      98798798      dkfnjhklabnkl

and then it adds 20 lines after Chevy Cars.  It should add 20 lines after every unique "car maker".

I'm sorry about the confusion.
0
 
jeveristCommented:
Tod,

>  The pivot actually looks more like the one below

I still think it may be better to start with the sheet that has the pivot table and just grab the data we're interested in.  Try this from sheet with the pivot:

Sub CopyPivotDataII()
Dim ws As Worksheet, ws_new As Worksheet, pt As PivotTable, rng As Range, cel As Range, rngcpy As Range, i As Long, irow As Long

Set ws = ActiveSheet
Set ws_new = Worksheets.Add

If ws.PivotTables.Count < 1 Then
    MsgBox "No PivotTables found on ActiveSheet.  Exiting routine.", vbInformation
    Exit Sub
End If

Set pt = ws.PivotTables(1)
Set rng = pt.TableRange1.Columns(2)

irow = 1
i = rng.Row

For Each cel In rng.Cells
    If (cel.Value <> cel.Offset(1).Value And cel.Offset(1).Value <> "" And cel.Row <> 1) Or cel.Row = rng.Cells(rng.Cells.Count).Row Then
        Set rngcpy = Range(rng.Cells(i), cel)
        rngcpy.Resize(ColumnSize:=pt.TableRange1.Columns.Count - 1).Copy Destination:=ws_new.Cells(irow, "A")
        i = cel.Offset(1).Row
        irow = irow + 20
    End If
Next cel

End Sub

Let me know if this works for you.

Jim
0
 
tkeifferAuthor Commented:
Hi Jim,
Thank you so much for your help and sorry for the delay.  I've attached a spreadsheet that has a simple pivot with the data I'm actually using, and an example sheet of how I'm trying to sort the data.  Is this possible?

http://my.storenow.net?f=1767 
0
 
tkeifferAuthor Commented:
That's the winner. Thank you Jim.  I apologize for opening a duplicate, I looked at your history and it seemed like you might be out for a few.  Thank you so much for your help.
0
 
jeveristCommented:
tkeiffer,

>  you might be out for a few

If you mean you think I've been busy for the past few days then you are correct.

Good luck and thanks for the grade!

Jim
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.