Код |
---|
Sub Макрос2() Cells.Select Range("I1").Activate Selection.ClearContents Sheets("Sheet1").Select Cells.Select Selection.Copy Sheets("БАЗА").Select Cells.Select Range("I1").Activate ActiveSheet.Paste Application.CutCopyMode = False Dim sSubStr As String Dim lCol As Long Dim lLastRow As Long, li As Long Dim arr sSubStr = "" lCol = 26 If lCol = 0 Then Exit Sub lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range For li = 2 To lLastRow If CStr(arr(li, 1)) <> sSubStr Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub |
Спасибо.