宏应该从一张纸和一张纸上复制数据。在另一张纸上粘贴不同的格式

Question

我对VBA很新，因此我需要你的帮助来完成这项任务。

目前我有一张名为“Sample_Raw_Data”的表格，其中包含所有原始详细信息。

现在我要复制“Sample_Raw_Data”中的每一行，并分成22行（即2015年，2016年，2017年，2018年和2019年每年还有4种费用明细）并粘贴在下面的格式中另一张表

=============================================== ===================================

集团，中等，主题，州，地区，城市，销售分区1，费用明细，年份，总费用

有人可以告诉我VBA代码来执行此任务吗？

我已经从“Sample_Raw_Data”更新了样本的一行数据，并将其粘贴到“宏结果”表中的21个不同的行中。

以下是附件链接：https://www.dropbox.com/s/s9y5oyq07kwgary/Sample%20Data.xlsx

非常感谢您的帮助

最诚挚的问候 Amrutha

Answer 1

我可以在朋友的帮助下获得以下代码。

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