Splitting data into several worksheets based on page breaks - help with VBA macro

S

sharicn

New Member
Joined
May 24, 2010
Messages
32
Hello,

I am a novice when it comes to VBA - I can usually modify code that I find in forums such as these to get it to work for my circumstances, but I'm not great at creating my own. I'm hoping that someone can help me with a macro to split some data into separate worksheets based on page breaks. I have data that is subtotaled by firm and divided with a page break. Ideally, what I'd like to do is to put each firm in a separate worksheet that retains the same formatting, header, and top header row (A1) as the initial worksheet, with each of the worksheets being named for the firm whose data it contains.

I've managed to find some code that splits the page into separate worksheets, but it does not have all the bells and whistles I mentioned above. The code is below, along with a sample from my worksheet, and I'm hoping that someone can help me modify it. It would make my life so much easier, especially since the database from which I am pulling my data has limitations of its own, which is what makes me want to pull the information into Excel in the first place instead of running one of its "canned" reports.

Thanks in advance for any help you can provide,
Shari

Code: 
Sub Create_Separate_Sheet_For_Each_HPageBreak()
    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range
 
    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet
 
    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")
 
    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True
 
    RW = 1
    PageNum = 1
 
    For Each HPB In Asheet.HPageBreaks
    If HPB.Type = xlPageBreakManual Then
   
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(After:=.Sheets(.Sheets.Count))
        End With
 
        'Give the sheet a name
        On Error Resume Next
        Nsheet.Name = "Page " & PageNum
        If Err.Number > 0 Then
            MsgBox "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If
        On Error GoTo 0
 
        'Copy the cells from the page into the new sheet
        With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy _
                    Nsheet.Cells(1)
        End With
        ' If you want to make values of your formulas use this line also
        ' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value
 
        RW = HPB.Location.Row
        PageNum = PageNum + 1
        End If
    Next HPB
 
    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


[TABLE="width: 956"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Firm[/TD]
[TD]Firmmember[/TD]
[TD]2014 direct gifts, pledges, or matches[/TD]
[TD]2014 soft credits not from the firm (count towards total)[/TD]
[TD]2014 soft credits from the firm (do not count towards total)[/TD]
[TD]2013 direct gifts, pledges, or matches[/TD]
[TD]2013 soft credits not from the firm (count towards total)[/TD]
[TD]2013 soft credits from the firm (do not count towards total)[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$40.00[/TD]
[TD][/TD]
[TD="align: right"]$140.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[TD][/TD]
[TD="align: right"]$150.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$100.00[/TD]
[TD][/TD]
[TD="align: right"]$200.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$70.00[/TD]
[TD][/TD]
[TD="align: right"]$170.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Associate[/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$120.00[/TD]
[TD][/TD]
[TD="align: right"]$220.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Associate Count[/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ater Wynne LLP[/TD]
[TD]Ater Wynne[/TD]
[TD]Firm[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$10,215.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Firm Count[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$250.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$100.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$150.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$25.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$20.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$200.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$100.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Partner Count[/TD]
[TD="align: right"]26[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Senior Counsel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$250.00[/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Senior Counsel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,800.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Senior Counsel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$300.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Senior Counsel Count[/TD]
[TD="align: right"]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$15.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$10.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Ater Wynne[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Staff Count[/TD]
[TD="align: right"]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Ater Wynne Total[/TD]
[TD][/TD]
[TD="align: right"]$100.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$13,185.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$11,080.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$340.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$50.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$320.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$10.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$320.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$320.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD]John Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Associate[/TD]
[TD="align: right"]$320.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD][/TD]
[TD="align: right"]$525.00[/TD]
[TD="align: right"]$725.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Associate Count[/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Barran Liebman LLP[/TD]
[TD]Barran Liebman[/TD]
[TD]Firm[/TD]
[TD="align: right"]$17,925.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$17,150.08[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Firm Count[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jane Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Of Counsel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Of Counsel Count[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD="align: right"]$5,075.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$6,265.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$2,575.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,500.00[/TD]
[TD="align: right"]$40.00[/TD]
[TD][/TD]
[TD="align: right"]$1,500.00[/TD]
[/TR]
[TR]
[TD]Jim Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Partner[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$1,250.00[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Partner Count[/TD]
[TD="align: right"]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$80.00[/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD="align: right"]$300.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[TD="align: right"]$310.00[/TD]
[TD][/TD]
[TD="align: right"]$700.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD]Joan Smith[/TD]
[TD]Barran Liebman[/TD]
[TD]Staff[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]$50.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Staff Count[/TD]
[TD="align: right"]13[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Barran Liebman Total[/TD]
[TD][/TD]
[TD="align: right"]$25,460.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$17,100.00[/TD]
[TD="align: right"]$25,465.08[/TD]
[TD="align: right"]$525.00[/TD]
[TD="align: right"]$17,100.00[/TD]
[/TR]
</tbody>[/TABLE]


Header reads as follows:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Confidential Information
[/TD]
[TD="align: center"]Campaign for Equal Justice
[/TD]
[TD]Please Do Not Distribute
[/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Firm Report
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]&[Date]
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Sort by date Sort by votes
1. It's copying row A1 to the first worksheet, but not the subsequent ones.
2. It's also asking me to manually name every subsequent worksheet after the first one,
3. it's not copying formatting from the first worksheet (landscape, column widths, header/footer, etc).
Click to expand...
1. & 2. I would need to see the code as you have revised it to before attempting to analyze 1 and 2 above.
3. Landscape is not a format property, it is a page set up property and will not transfer with a copy method. The new sheet will use whatever your default setting is. Your option is to add a line of code like:
Code: 
Nsheet.PageSetup.Orientation = xlLandscape
after the new sheet is created.
I have not dealt with headers and footers in a long time, but I would assume that they are similar to landscape and are not part of the Formats collection. Which means you would also need code to add those back into each sheet. See 'Formatting and VBA Codes for Headers and Footers' in VBA help files in the VB Editor. You have six options of headers and footers that you can use.
For the other formatting, you would have to use PasteSpecial method instead of the direct copy/paste method.
Change this:
Code: 
With Asheet
   .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy _
      Nsheet.Cells(1)
End With
to this:
Code: 
With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy 
            Nsheet.Cells(1).PasteSpecial xlPasteAll
End With

Note that the underscore line is removed in the PasteSpecial method.
 
Last edited:
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Thanks so much for the tips on landscape, headers, and paste special. I've managed to get that part worked out. Here is the code I have now; hopefully you can help with those first two issues. Let me know if there is a way I can get my Excel file to you, if you think that would be helpful. You are not only helping me with my issue, but helping me to learn as well, and I do appreciate it.

Code: 
Sub Create_Separate_Sheet_For_Each_HPageBreak2()
    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range
    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet
    ActiveWindow.View = xlPageBreakPreview
    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")
    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True
    RW = 1
    PageNum = 1
    For Each HPB In Asheet.HPageBreaks
    If HPB.Type = xlPageBreakManual Then
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(After:=.Sheets(.Sheets.Count))
        End With
        'Give the sheet a name
        On Error Resume Next
        Nsheet.Name = Asheet.Range("B2")
 Asheet.Rows(1).Copy Nsheet.Range("A1")
        If Err.Number > 0 Then
            MsgBox "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If
        On Error GoTo 0
        'Copy the cells from the page into the new sheet
With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy
            Nsheet.Cells(1).PasteSpecial xlPasteAll
End With
 
        ' If you want to make values of your formulas use this line also
        ' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value
        RW = HPB.Location.Row
        'PageNum = PageNum + 1
        End If

 With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.85)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.25)
    .FooterMargin = Application.InchesToPoints(0.25)
    .Orientation = xlLandscape
    .LeftHeader = "Confidential Information"
    .CenterHeader = "Campaign for Equal Justice" & Chr(13) & Format(ActiveSheet.Range("B2").Value) & Chr(13) & "Firm Report - &D"
    .RightHeader = "Please Do Not Distribute"
    .CenterFooter = "Page &P of &N"
End With    Next HPB
    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Last edited:
Upvote 0
It looks like you are getting an error and the 'On Error Resume Next' is preventing the error message from showing. This version uses a different trap which will show on which line the error occurs and what the error is. Then we can work from that to fix the problem. I also added the property Value on the line that assigns the sheet name. That may or may not fix that problem. Note any errors that are reported as you run the code and whether they are for the sheet name or the header copy.
Code: 
Sub Create_Separate_Sheet_For_Each_HPageBreak2()
    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range
    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet
    ActiveWindow.View = xlPageBreakPreview
    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")
    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True
    RW = 1
    PageNum = 1
    For Each HPB In Asheet.HPageBreaks
    If HPB.Type = xlPageBreakManual Then
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(After:=.Sheets(.Sheets.Count))
        End With
        'Give the sheet a name
        On Error GoTo ANAL1:
        Nsheet.Name = Asheet.Range("B2").Value
ANAL1:
  If Err.Number > 0 Then
   MsgBox Err.Number & ":  " & Err.Description & "Error on sheet name"
   Err.Clear
  End If
 On Error GoTo ANAL2:
  Asheet.Rows(1).Copy Nsheet.Range("A1")
ANAL2:
        If Err.Number > 0 Then 
            MsgBox Err.Number & ":  " & Error.Description & "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If       
        'Copy the cells from the page into the new sheet
With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy
            Nsheet.Cells(1).PasteSpecial xlPasteAll
End With 
        ' If you want to make values of your formulas use this line also
        ' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value
        RW = HPB.Location.Row
        'PageNum = PageNum + 1
        End If
 With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.85)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.25)
    .FooterMargin = Application.InchesToPoints(0.25)
    .Orientation = xlLandscape
    .LeftHeader = "Confidential Information"
    .CenterHeader = "Campaign for Equal Justice" & Chr(13) & Format(ActiveSheet.Range("B2").Value) & Chr(13) & "Firm Report - &D"
    .RightHeader = "Please Do Not Distribute"
    .CenterFooter = "Page &P of &N"
End With    Next HPB
    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
Interesting. Now I receive the following error: "Run-time Error '1004' Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"

This happens after it pastes the information into the first new sheet and creates the second sheet -- stops at the last line at this point in the code:

Code: 
ANAL1:
  If Err.Number > 0 Then
   MsgBox Err.Number & ":  " & Err.Description & "Error on sheet name"
   Err.Clear
 
Upvote 0
sharicn said:
Interesting. Now I receive the following error: "Run-time Error '1004' Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"

This happens after it pastes the information into the first new sheet and creates the second sheet -- stops at the last line at this point in the code:

Code: 
ANAL1:
  If Err.Number > 0 Then
   MsgBox Err.Number & ":  " & Err.Description & "Error on sheet name"
   Err.Clear
Click to expand...

I wondered about that when you said the Firm name would always be in cell B2. The sample data that you put up showed that the firm name changed after each pagebreak and is why i had the offset statement in there. I was trying to get the name in column B since it looked like the Firm name would be in that column for the entire page, until the next page break.
This statement:
Code: 
Nsheet.Name = Asheet.Range("B" & HPB.Location.Row).End(xlDown).Value
should go to column B on the same row as the pagebreak, then find the first cell with date below that, which should be the firm name for that page. Try changing that back and see if it still gives the error.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Conditional sum help?
Replies
5
Views
5K
stanleydgromjr
S

Forum statistics

Threads
1,223,889
Messages
6,175,226
Members
452,620
Latest member
dsubash

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top