Please please help! - vba

wrightyrx7

wrightyrx7

Well-known Member
Joined
Sep 15, 2011
Messages
994
Hi all i hvae a macro as show below which take a report i run in work on a monthly basis and creates and calculates all the worksheets. I have a problem though, it copies rows that only have data in the specified columns to a new worksheet..

But its copying from the Master Worksheet (Image 1)

80001185.jpg


But puts it on to the created worksheets like (Image 2)

81886504.jpg


Please can you have a look at the code below and tell me what im doing wrong?

Many thanks
Chris

Rich (BB code): 
Sub Penpay_Format_Worksheets()

Dim LastRow As Long

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Pensionable Pay"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[5]:RC[24])"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G" & LastRow)
    Range("G2:G" & LastRow).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
        Rows("1:1").Select
    Selection.Font.Bold = True

    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "EE GMPF Added Years"
    Range("AL1").Select
    ActiveCell.FormulaR1C1 = "EE GMPF Add Regular Con"
    Range("AM1").Select
    ActiveCell.FormulaR1C1 = "EE GMPF AVC"
    Range("AN1").Select
    ActiveCell.FormulaR1C1 = "EE LGPS"
    Range("AO1").Select
    ActiveCell.FormulaR1C1 = "EE Teachers Pension"
    Range("AP1").Select
    ActiveCell.FormulaR1C1 = "EE Teachers Pension Add"
    Range("AQ1").Select
    ActiveCell.FormulaR1C1 = "EE Teachers Pension AVC"
    Range("AR1").Select
    ActiveCell.FormulaR1C1 = "EE TP PT Buy Back"
    Range("AS1").Select
    ActiveCell.FormulaR1C1 = "EE TP Step Down"
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "ER GMPF Added Years"
    Range("BC1").Select
    ActiveCell.FormulaR1C1 = "ER GMPF Add Regular Con"
    Range("BD1").Select
    ActiveCell.FormulaR1C1 = "ER GMPF AVC"
    Range("BE1").Select
    ActiveCell.FormulaR1C1 = "ER LGPS"
    Range("BF1").Select
    ActiveCell.FormulaR1C1 = "ER Teachers Pension"
    Range("BG1").Select
    ActiveCell.FormulaR1C1 = "ER Teachers Pension Add"
    Range("BH1").Select
    ActiveCell.FormulaR1C1 = "ER Teachers Pension AVC"
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "ER TP PT Buy Back"
    Range("BJ1").Select
    ActiveCell.FormulaR1C1 = "ER TP Step Down"
    Range("BJ2").Select
    
'CREATE WORKSHEETS
    Worksheets.Add(After:=Worksheets(1)).Name = "GMPF Added Years"
Worksheets.Add(After:=Worksheets(2)).Name = "GMPF Add Reg Cont"
Worksheets.Add(After:=Worksheets(3)).Name = "GMPF AVC"
Worksheets.Add(After:=Worksheets(4)).Name = "GMPF"
Worksheets.Add(After:=Worksheets(5)).Name = "TP"
Worksheets.Add(After:=Worksheets(6)).Name = "TP Add"
Worksheets.Add(After:=Worksheets(7)).Name = "TP AVC"
Worksheets.Add(After:=Worksheets(8)).Name = "TP PT Buy Back"
Worksheets.Add(After:=Worksheets(9)).Name = "TP Step Down"
With Worksheets(1)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For Row = 1 To LastRow Step 1
    If .Range("AK" & Row) <> "" Or .Range("BB" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(2).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AK" & Row).Copy Destination:=Worksheets(2).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BB" & Row).Copy Destination:=Worksheets(2).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AL" & Row) <> "" Or .Range("BC" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(3).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AL" & Row).Copy Destination:=Worksheets(3).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BC" & Row).Copy Destination:=Worksheets(3).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AM" & Row) <> "" Or .Range("BD" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(4).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AM" & Row).Copy Destination:=Worksheets(4).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BD" & Row).Copy Destination:=Worksheets(4).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AN" & Row) <> "" Or .Range("BE" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(5).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AN" & Row).Copy Destination:=Worksheets(5).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BE" & Row).Copy Destination:=Worksheets(5).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AO" & Row) <> "" Or .Range("BF" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(6).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AO" & Row).Copy Destination:=Worksheets(6).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BF" & Row).Copy Destination:=Worksheets(6).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AP" & Row) <> "" Or .Range("BG" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(7).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AP" & Row).Copy Destination:=Worksheets(7).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BG" & Row).Copy Destination:=Worksheets(7).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AQ" & Row) <> "" Or .Range("BH" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(8).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AQ" & Row).Copy Destination:=Worksheets(8).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BH" & Row).Copy Destination:=Worksheets(8).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AR" & Row) <> "" Or .Range("BI" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(9).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AR" & Row).Copy Destination:=Worksheets(9).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BI" & Row).Copy Destination:=Worksheets(9).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AS" & Row) <> "" Or .Range("BJ" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(10).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AS" & Row).Copy Destination:=Worksheets(10).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BJ" & Row).Copy Destination:=Worksheets(10).Range("I65536").End(xlUp).Offset(1, 0)
    End If
Next Row
End With
Worksheets(2).Range("A1").EntireRow.Delete
Worksheets(3).Range("A1").EntireRow.Delete
Worksheets(4).Range("A1").EntireRow.Delete
Worksheets(5).Range("A1").EntireRow.Delete
Worksheets(6).Range("A1").EntireRow.Delete
Worksheets(7).Range("A1").EntireRow.Delete
Worksheets(8).Range("A1").EntireRow.Delete
Worksheets(9).Range("A1").EntireRow.Delete
Worksheets(10).Range("A1").EntireRow.Delete

Dim ShtCount As Long, _
    Sht As Long, _
    LstRw As Long, _
    ThsRw As Long
    
ShtCount = ThisWorkbook.Worksheets.Count
If ShtCount < 10 Then MsgBox "You only have " & ShtCount & " sheets in this workbook." & vbNewLine & _
                             "This routine will be cancelled.": Exit Sub

For Sht = 2 To 10
  With Sheets(Sht)
    .Cells.Columns.AutoFit
    .Cells(1, "J").Value = "Total"
    .Cells(1, "J").Font.Bold = True
    LstRw = .Cells(Rows.Count, "H").End(xlUp).Row
    For ThsRw = 2 To LstRw
      .Cells(ThsRw, "J").Value = Application.WorksheetFunction.Sum(.Cells(ThsRw, "H"), .Cells(ThsRw, "I"))
    Next ThsRw
    .Cells(LstRw + 2, "H").Value = Application.WorksheetFunction.Sum(.Range("H2:H" & LstRw))
    .Cells(LstRw + 2, "H").Font.Bold = True
    .Cells(LstRw + 2, "I").Value = Application.WorksheetFunction.Sum(.Range("I2:I" & LstRw))
    .Cells(LstRw + 2, "I").Font.Bold = True
    .Cells(LstRw + 2, "J").Value = Application.WorksheetFunction.Sum(.Range("J2:J" & LstRw))
    .Cells(LstRw + 2, "J").Font.Bold = True
  End With
Next Sht

'''SummaryPage

    
    Worksheets.Add(After:=Worksheets(10)).Name = "Summary"
    
    Sheets("Summary").Select
    Range("A1").Select
    ActiveCell.Value = "Pension Summary"
    Range("A3").Select
    ActiveCell.Value = "Contribution Type"
    Range("A4").Select
    ActiveCell.Value = "GMPF Added Years"
    Range("A5").Select
    ActiveCell.Value = "GMPF Additional Regular Contributions"
    Range("A6").Select
    ActiveCell.Value = "GMPF"
    Range("A7").Select
    ActiveCell.Value = "Total GMPF Pension Payover"
    Range("A9").Select
    ActiveCell.Value = "GMPF AVC"
    Range("A10").Select
    ActiveCell.Value = "Total GMPF AVC Prudential Payover"
    Range("A12").Select
    ActiveCell.Value = "TP"
    Range("A13").Select
    ActiveCell.Value = "TP Added Years"
    Range("A14").Select
    ActiveCell.Value = "TP Part Time Buy Back"
    Range("A15").Select
    ActiveCell.Value = "TP Step Down"
    Range("A16").Select
    ActiveCell.Value = "Total TP Payover"
    Range("A18").Select
    ActiveCell.Value = "TP AVC"
    Range("A19").Select
    ActiveCell.Value = "Total TP ACV Prudential Payover"
    Range("B3").Select
    ActiveCell.Value = "EES"
    Range("C3").Select
    ActiveCell.Value = "ERS"
    Range("D3").Select
    ActiveCell.Value = "Journal Value"
    
    
    Range("A1:D3").Select
    Selection.Font.Bold = True
    Cells.Columns.AutoFit

With Sheets("GMPF Added Years")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B4")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C4")
End With

With Sheets("GMPF Add Reg Cont")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B5")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C5")
End With

With Sheets("GMPF")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B6")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C6")
End With

With Sheets("GMPF AVC")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B9")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C9")
End With

With Sheets("TP")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B12")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C12")
End With

With Sheets("TP Add")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B13")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C13")
End With

With Sheets("TP PT Buy Back")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B14")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C14")
End With

With Sheets("TP Step Down")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B15")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C15")
End With

With Sheets("TP AVC")
    LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
    .Range("H" & LastRow).Copy Sheets("Summary").Range("B18")
    LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
    .Range("I" & LastRow).Copy Sheets("Summary").Range("C18")
End With
    

    Range("B4:C17").Select
    Selection.Font.Bold = False
    
    
    
    'Calculate Summary
    Range("B7").Select
    ActiveCell.Value = "=SUM(B4:C6)"
    Range("B7:C7").Select
    Range("C7").Activate
    Selection.Merge
    
    
    Range("B10").Select
    ActiveCell.Value = "=SUM(B9:C9)"
    Range("B10:C10").Select
    Range("C10").Activate
    Selection.Merge
    
    Range("B16").Select
    ActiveCell.Value = "=SUM(B12:C15)"
    Range("B16:C16").Select
    Range("C16").Activate
    Selection.Merge
    
    Range("B19").Select
    ActiveCell.Value = "=SUM(B18:C18)"
    Range("B19:C19").Select
    Range("C19").Activate
    Selection.Merge
    
'BOLD, ALIGN & FORMAT
    Range("B7:C7").Select
    Selection.Font.Bold = True
    Range("B10:C10").Select
    Selection.Font.Bold = True
    Range("B16:C16").Select
    Selection.Font.Bold = True
    Range("B19:C19").Select
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("B4:C19").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("B7:C7").Select
    Range("B1:D19").Select
    Selection.HorizontalAlignment = xlCenter
    Cells.Columns.AutoFit
    Range("A1").Select
    MsgBox ("Process completed successfully")
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
376
Peter_SSs
Peter_SSs
G
  • Solved
Button for a For Loop
Replies
3
Views
127
Joe4
Joe4
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R
C
  • Solved
Need Help VBA
2
Replies
10
Views
433
Trebor76
T
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
152
howard
H

Forum statistics

Threads
1,224,583
Messages
6,179,673
Members
452,937
Latest member
Bhg1984

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