maybe this is not best-practise, but the following macro should do, what you Need:
Option ExplicitSub sortByCategoryAndYear() Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet Dim rng As Range, rngTitle As Range Dim countYears As Long, i As Long, col As Long, lr As Long, lr3 As Long, lr4 As Long, RowCategory As Long, RowYear As Long, x As Long Dim strBoth As String, strFemale As String, strMale As String, strYear As StringSet ws1 = ThisWorkbook.Sheets("Sheet1") Set ws3 = ThisWorkbook.Sheets("Sheet3") Set ws4 = ThisWorkbook.Sheets("Sheet4")ws3.Cells.ClearContents With ws4 'get last used row lr4 = .Cells(Rows.Count, 1).End(xlUp).Row 'set ranges .Range(.Cells(3, 1), .Cells(lr4, 1)).Copy Destination:=ws3.Cells(3, 1)End With'Calculate sums per Year and category in Sheets 3With ws3 'add Titles.Cells(1, 1).Value = "Population" .Cells(1, 6).Value = "Death" .Cells(1, 11).Value = "Birth" For i = 1 To 11 Step 5 'get years ws4.Range(ws4.Cells(2, 1), ws4.Cells(2, 5)).Copy Destination:=.Cells(2, i) Next i 'copy years into row 1 lr3 = .Cells(Rows.Count, 1).End(xlUp).Row 'delete duplicated years .Range(.Cells(3, 1), .Cells(lr3, 1)).RemoveDuplicates Columns:=1, Header:=xlNo 'get last row in sheet3 lr3 = .Cells(Rows.Count, 1).End(xlUp).Row 'Sum Population For col = 1 To 11 Step 5 For i = 3 To lr3 For x = 1 To 3 .Cells(i, col + x).Value = SumPerYearAndCategory(col, col + x, i, lr4) Next x Next i Next col End With'Populates values on sheet 1With ws1 'clear all contents .Cells.ClearContents 'add titles .Cells(1, 1) = "CATEGORY" .Cells(1, 2) = "TIME" .Cells(1, 3) = "INDICATOR" .Cells(1, 4) = "SUM" .Cells(2, 1) = "First" countYears = lr3 - 2 RowCategory = 3 For col = 1 To 11 Step 5 .Cells(RowCategory, 1).Value = ws3.Cells(1, col).Value For i = 1 To countYears RowYear = RowCategory + (i - 1) * 4 With ws1 .Cells(RowYear, 2).Value = ws3.Cells(i + 2, 1).Value .Cells(RowYear + 1, 3).Value = "Male" .Cells(RowYear + 2, 3).Value = "Female" .Cells(RowYear + 3, 3).Value = "Both Sexes" .Cells(RowYear + 1, 4).Value = ws3.Cells(i + 2, col + 1).Value .Cells(RowYear + 2, 4).Value = ws3.Cells(i + 2, col + 2).Value .Cells(RowYear + 3, 4).Value = ws3.Cells(i + 2, col + 3).Value End With 'ws1.Cells(RowYear + 1, 3).Value = ws3.Cells(i + 2, 2).Value Next i RowCategory = .Cells(Rows.Count, 3).End(xlUp).Row + 1 Next col 'Indicator End WithEnd SubFunction SumPerYearAndCategory(columnCategory As Long, columnSum As Long, currentRow As Long, lastRow As Long) As String'Function to get the sums per year and per category Dim ws3 As Worksheet, ws4 As Worksheet Set ws3 = ThisWorkbook.Sheets("Sheet3") Set ws4 = ThisWorkbook.Sheets("Sheet4")SumPerYearAndCategory = Application.WorksheetFunction.SumIf(ws4.Range(ws4.Cells(3, columnCategory), ws4.Cells(lastRow, colCat)), ws3.Cells(currentRow, 1), ws4.Range(ws4.Cells(3, columnSum), ws4.Cells(lastRow, columnSum)))End Function
Thank you for your reply and solution. It seems there is some confusion. Let me explain what I want in better way.
First of all there are only two sheets needed. Sheet1 and Sheet2.
Sheet1 has two scenes: 1 what is current (A to D) and What I am expecting is (G to J) and Sheet 4 has all the raw values.
What is happening:
Step 1: Add 4 rows below cell 2
Step2: Add year (B7 +1) in Time column
Step3: Move content: What ever you see before latest year i.e. 2014 to Above. It means Pro<15, Pro15-59 and Pro60+ should shift from A3, A11 and A 19 to appropriate place. They should always come infront of latest year in column A.
Step4: Add values from Population sheet to automation sheet for Male, Female and Both Sexes.
I hope I am explained everything here. Let me know if you still have any doubt.
Please find below new sheet for your more information.
Somnathon April 17, 2017.