回复 6楼 owenlu1981
看了一下您的,离我的要求还有一定的问题:
自己重新弄了一下:
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工作表的功能。