[Solved] Macro should copy data from One sheet & paste in different format in another sheet

by


I could able to get the below code with my friends help.

Sub splitData()
Dim wb As Workbook
Dim wsSample As Worksheet
Dim wsMacro As Worksheet
Dim lr As Long
Dim i As Long
Dim j As Integer
Dim wRow As Long

Set wb = ActiveWorkbook
Set wsSample = wb.Worksheets("Sample_Raw_Data")
Set wsMacro = wb.Worksheets("Macro Results")
lr = wsSample.Range("a" & Rows.Count).End(xlUp).Row 'last row of data in column A

Application.WindowState = xlMinimized
Application.ScreenUpdating = False

With wsMacro
    For i = 5 To lr
        If Not IsEmpty(wsSample.Range("a" & i)) Then
            wRow = .Range("a" & Rows.Count).End(xlUp).Row + 1   'WRITE row in Macro sheet
            For j = 1 To 7
                .Cells(wRow, j) = wsSample.Cells(i, j)
            Next j
            .Cells(wRow, 8) = "Base Fees"
            .Cells(wRow, 9) = "2014"
            .Cells(wRow, 10) = wsSample.Cells(i, 8)
            
            .Range("a" & wRow & ":g" & wRow).Copy
            .Range("a" & wRow + 1 & ":a" & wRow + 20).PasteSpecial
            
            .Range("h" & wRow + 1 & ":h" & wRow + 5).Value = "Hostel Fees"
            For j = 1 To 5
                .Cells(wRow + j, 9) = 2014 + j
                .Cells(wRow + j, 10) = wsSample.Cells(i, 9 + ((j - 1) * 5))
            Next j
            .Range("h" & wRow + 6 & ":h" & wRow + 10).Value = "Books"
            For j = 1 To 5
                .Cells(wRow + 5 + j, 9) = 2014 + j
                .Cells(wRow + 5 + j, 10) = wsSample.Cells(i, 10 + ((j - 1) * 5))
            Next j
            .Range("h" & wRow + 11 & ":h" & wRow + 15).Value = "Dress"
            For j = 1 To 5
                .Cells(wRow + 10 + j, 9) = 2014 + j
                .Cells(wRow + 10 + j, 10) = wsSample.Cells(i, 11 + ((j - 1) * 5))
            Next j
            .Range("h" & wRow + 16 & ":h" & wRow + 20).Value = "Tuition"
            For j = 1 To 5
                .Cells(wRow + 15 + j, 9) = 2014 + j
                .Cells(wRow + 15 + j, 10) = wsSample.Cells(i, 12 + ((j - 1) * 5))
            Next j
        End If
    Next i
    .Range("a1:j1").EntireColumn.AutoFit
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.WindowState = xlNormal

End Sub

1

solved Macro should copy data from One sheet & paste in different format in another sheet