|
- Sub 合并()
- Dim lLastrow As Long
- Dim i As Integer
- With Application
- .ScreenUpdating = False
- .DisplayAlerts = False
- .EnableEvents = False
- .Calculation = xlCalculationManual
- End With
- With Sheet1
- .UsedRange.Clear
- End With
- For i = 2 To Worksheets.Count
- With Worksheets(i)
- lLastrow = lLastrow + 1
- .Range("a1").CurrentRegion.Copy
- Sheet1.Cells(lLastrow, 1).Value = .Name
- With Sheet1
- .Cells(lLastrow + 1, 1).PasteSpecial xlPasteAll
- If Not .Cells(lLastrow + 1, 1) Like "编制单位*" Then
- .Rows(lLastrow + 1).Delete
- End If
- .Range(.Cells(lLastrow, 1), .Cells(lLastrow, .UsedRange.Columns.Count)).Interior.ColorIndex = 4
- lLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
- End With
- End With
- Next
- With Sheet1
- .UsedRange.EntireRow.AutoFit
- End With
- With Application
- .ScreenUpdating = True
- .DisplayAlerts = True
- .EnableEvents = True
- .Calculation = xlCalculationAutomatic
- End With
- MsgBox "合并完成"
- End Sub
复制代码 |
评分
-
查看全部评分
|