那个高手能帮帮忙，用VB有条件实现表格自动另存，且贴值，删除多余的表格。

自己弄了一个，但只能实现部分功能，那位老师指点一下？

那个老师帮忙看看啦

看了一下您的，离我的要求还有一定的问题：
自己重新弄了一下：
Sub Run()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Mc As String, n%, My As String, m%
With ThisWorkbook
For n = 24 To .Sheets("输入表").[J65536].End(xlUp).Row
Mc = .Sheets("输入表").Cells(n, 10).Value
.Sheets("输入表").[K14] = Mc
.Sheets("信息").[D11] = Mc
For m = 1 To .Sheets("sheet1").[A65536].End(xlUp).Row
My = .Sheets("sheet1").Cells(m, 1).Value
.Sheets("输入表").[L19] = My
.Sheets(Array("表一", "表三甲合", "表三丙", "表四甲1", "表四甲2", "表四甲4")).Copy
ActiveWorkbook.SaveAs Filename:=.Path & "\" & ThisWorkbook.Sheets("信息").Cells(5, 4) & "(" & My & ")预算.xls", FileFormat:=xlNormal
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
ActiveSheet.DrawingObjects.Delete
  
  For Each Sh In ActiveWorkbook.Sheets
         Sh.Select
         Sh.Cells.Select
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         Sh.Cells(1, 1).Select
      Next
     
     '各表删除空行
     
     With ActiveSheet
        Select Case ShName
        Case "表三丙"
            .Rows.Hidden = False
            iRow = 8
            i = 1
            Do While .Cells(iRow, 2) <> "I"
                If (.Cells(iRow, 6) = "") Or (.Cells(iRow, 6) = 0) Then
                   .Rows(iRow).Delete
                Else
                    .Cells(iRow, 2) = i
                    i = i + 1
                End If
                iRow = iRow + 1
            Loop
        Case Else
        End Select
        .Cells(1, 1).Select
     End With
      
    ActiveWorkbook.Close (True)
      
    Next
Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

现有3个问题请教：
1.    “For m = 1 To .Sheets("sheet1").[A65536].End(xlUp).Row”这个循环语句改为定值循环，因为这里只有4个定值：“全套”、“无线”、“电源”、“配套”，怎么改啊？

2.为什么删除空行的宏不行

3.同时还想增加删除生成的工作薄的合计为0工作表的功能。

老师呢，都这么忙吗？