请教各位高手，怎么用VBA写多次插入行后工作表的行数？谢谢！

ying076

将“源数据表”中的数据按“目的数据表”进行分类，在各分类后插入行进行求和小计，最后总计。我初学VBA，学写了一段不成熟的东西，请大家帮我改改（或帮重写一段）。谢谢！！！

ying076

自己上贴vba代码，请高手改改，谢谢！！sub 分类()
count1 = Sheet1.Range("b" & Rows.Count).End(xlUp).Row
count2 = Sheet2.Range("C" & Rows.Count).End(xlUp).Row
For x = 2 To count1
   For y = 2 To count2
       If Sheet1.Range("B" & x) = Sheet2.Range("C" & y) Then
            Sheet2.Range("F" & y) = Sheet1.Range("D" & x)
            Sheet2.Range("G" & y) = Sheet2.Range("F" & y) * Sheet2.Range("E" & y)
            Sheet2.Range("H" & y) = Sheet1.Range("F" & x)
            Sheet2.Range("I" & y) = Sheet2.Range("H" & y) * Sheet2.Range("E" & y)
            Sheet2.Range("J" & y) = Sheet1.Range("H" & x)
            Sheet2.Range("K" & y) = Sheet2.Range("J" & y) * Sheet2.Range("E" & y)
            y = y + 1
       ' Else: （插入没有找到的数据）
        End If
    Next
Next

introwscount = Sheet2.Range("A" & Rows.Count).End(xlUp).Row '求插入小计行前的行数
  Sheet2.Activate
  z = 2
  Do
    For x = 2 To introwscount
        If Sheet2.Range("A" & x) <> Sheet2.Range("A" & x + 1) Then '给分类插入小计行
           Sheet2.Rows(x + 1).Resize(1).Insert 'X+1处插入一空行;
           '合并["A"&X+1:"E"&X+1],
            Sheet2.Range("A" & x + 1, "E" & x + 1).Select '选合并对象
            Selection.Merge '合并
           Sheet2.Range("A" & x + 1, "K" & x + 1).Interior.ColorIndex = 24 '给合并行加颜色
            Sheet2.Range("A" & x + 1) = "小计"
            x = x + 1
        End If
        introwscount = introwscount + 1
    Next
    Loop While x = introwscount
       introwscount1 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row '求插入小计行后的行数
          Sheet2.Rows(introwscount1 + 1).Resize(1).Insert '给最后分类插入小计行
            Sheet2.Range("A" & introwscount1 + 1, "E" & introwscount1 + 1).Select '选合并对象
            Selection.Merge '合并["A"&X+1:"E"&X+1]
            Sheet2.Range("A" & introwscount1 + 1, "K" & introwscount1 + 1).Interior.ColorIndex = 24 '给合并行加颜色
            Sheet2.Range("A" & introwscount1 + 1) = "小计"
            
       introwscount1 = introwscount1 + 1
          Sheet2.Rows(introwscount1 + 1).Resize(1).Insert '给最后分类插入小计行
            Sheet2.Range("A" & introwscount1 + 1, "F" & introwscount1 + 1).Select '选合并对象
            Selection.Merge '合并["A"&X+1:"F"&X+1]
            Sheet2.Range("A" & introwscount1 + 1, "K" & introwscount1 + 1).Interior.ColorIndex = 18 '给合并行加颜色
            Sheet2.Range("A" & introwscount1 + 1) = "总计"
            
     For y = 5 To introwscount1 '给分类小计求和，并赋值
         If Sheet2.Range("A" & y) = "小计" Then
            Sheet2.Cells(y, 7) = Application.WorksheetFunction.Sum(Range("G" & z & ":G" & y)) '区域求和，并赋"小计"值
               Sheet2.Range("G" & introwscount1 + 1) = Sheet2.Range("G" & introwscount1 + 1) + Sheet2.Cells(y, 7)
            Sheet2.Cells(y, 9) = Application.WorksheetFunction.Sum(Range("I" & z & ":I" & y))
               Sheet2.Range("I" & introwscount1 + 1) = Sheet2.Range("I" & introwscount1 + 1) + Sheet2.Cells(y, 9)
            Sheet2.Cells(y, 11) = Application.WorksheetFunction.Sum(Range("K" & z & ":K" & y))
               Sheet2.Range("K" & introwscount1 + 1) = Sheet2.Range("K" & introwscount1 + 1) + Sheet2.Cells(y, 11)
            'Sheet2.Cells(y, 14) = Application.WorksheetFunction.Sum(Range("N" & z & ":N" & y))
               'Sheet2.Range("N" & introwscount1 + 1) = Sheet2.Range("N" & introwscount1 + 1) + Sheet2.Cells(y, 14)
            z = y + 1
          End If
     Next
End Sub

Sub 清除()
Sheet2.Activate
count2 = Sheet2.Range("C" & Rows.Count).End(xlUp).Row
      Sheet2.Range("F2", "K" & count2) = ""
       For i = count2 + 2 To 2 Step -1 '清除“小计”和“总计”的行
           If Cells(i, 1).Value = "小计" Or Cells(i, 1).Value = "总计" Then
              Rows(i & ":" & i).Delete '删除行
           End If
       Next
End Sub

ying076

这个代码执行后，分类的“小计”只能一部被插入。