Извиняюсь.....
Sub Макрос()
FileCopy "Z:\PA_command_recep_par_CM_New.xls", "O:\Звіти 2012\Звіт тижневий основний\PA_command_recep_par_CM_New.xls"
IName = Звіт
iFullName = "O:\ЗВІТИ 2012\Звіт тижневий основний\PA_command_recep_par_CM_New.xls" & IName
With Application
.EnableEvents = False
.Workbooks.Open Filename:=iFullName
.EnableEvents = True
End With
Windows("PA_command_recep_par_CM_New.xls").Activate
Range("A2:B2").Select
With Columns("B:D")
.ColumnWidth = 10.05
.UnMerge
.ColumnWidth = 10.05
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
Range("A3:L3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="17"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="90"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="16"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="15"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="14"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="13"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="12"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="11"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="10"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="9"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="8"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="7"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="5"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1, Criteria1:="6"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2, Criteria1:="217"
Rows("4:3000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=3, Criteria1:="9001"
Rows("4:2000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=3
Columns("F:H").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""null"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Dim a
On Error Resume Next
a = [g3:h3000].Value
For i = 1 To UBound(a)
For j = 1 To UBound(a, 2)
a(i, j) = DateSerial(Left(a(i, j), 2), Mid(a(i, j), 3, 2), Mid(a(i, j), 5))
Next: Next: [g3:h3000].Value = a
Range("I4").Select
ActiveCell.FormulaR1C1 = "=RC[-4]-RC[-3]"
Range("I4").Select
Selection.AutoFill Destination:=Range("I4:I1099"), Type:=xlFillDefault
Range("I4:I2000").Select
Sheets("PA_command_recep_par_CM_New").Select
Range("A1").Select
With ActiveSheet.[a1].CurrentRegion
.AutoFilter 9, "<10"
.Offset(1).SpecialCells(12).EntireRow.Delete
.Parent.AutoFilterMode = 0
.Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, Orientation:=xlTopToBottom
End With
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6]:R[998]C[-6],'[Повні невиконання замовлень Потижнево.xls]Повні невиконання'!C1:C4,1,FALSE)"
Selection.AutoFill Destination:=Range("J2:J700")
Range("J2:J700").Select
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-7]:R[998]C[-7],'[Аномалії приймання Загальний звіт 2012.xls]Звіт'!C4:C7,1,FALSE)"
Selection.AutoFill Destination:=Range("K2:K900")
Range("K2:K900").Select
IName = Звіт
iFullName = "O:\ЗВІТИ 2012\Звіт тижневий основний\Основний готовий звіт.xls" & IName
With Application
.EnableEvents = False
.Workbooks.Open Filename:=iFullName
.EnableEvents = True
End With
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Windows("PA_command_recep_par_CM_New.xls").Activate
Range("A2:K1200").Select
Selection.Copy
Windows("Основний готовий звіт.xls").Activate
Range("I4:I800").Value = Range("I4:I800").Value
Range("A3").Select
ActiveSheet.Paste
Selection.AutoFilter Field:=6, Criteria1:="null"
Selection.AutoFilter Field:=10, Criteria1:="#n/a"
Range("A3:K1500").Select
Selection.ClearContents
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=10
Range("I4:I1000").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-54
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Sheets("Report").UsedRange
.Parent.AutoFilterMode = 0
.AutoFilter 8, "null"
.AutoFilter 10, "#n/a"
.Offset(1).SpecialCells(12).EntireRow.Delete
.AutoFilter 10
.Columns(7).Offset(1).SpecialCells(12).Copy Sheets("Failure to complete order").[a1]
.Columns(3).Offset(1).SpecialCells(12).Copy Sheets("Failure to complete order").[b1]
.Columns(4).Offset(1).SpecialCells(12).Copy Sheets("Failure to complete order").[d1]
.Columns(2).Offset(1).SpecialCells(12).Copy Sheets("Failure to complete order").[e1]
.Columns(5).Offset(1).SpecialCells(12).Copy Sheets("Failure to complete order").[f1]
.Parent.AutoFilterMode = 0
End With
Dim iRange As Range
Dim TextToFind As Variant
TextToFind = "null" 'искомый текст
If TextToFind = "" Or TextToFind = False Then Exit Sub
TextToFind = Trim(TextToFind)
With ActiveSheet.Cells
Set iRange = .Find(What:=TextToFind, LookIn:=xlFormulas, Lookat:=xlPart)
If Not iRange Is Nothing Then
Do
iRange.EntireRow.Delete
Set iRange = .Find(What:=TextToFind, LookIn:=xlFormulas, Lookat:=xlPart)
Loop While Not iRange Is Nothing
Else
Exit Sub
End If
End With
With Sheets("Report").UsedRange
.Parent.AutoFilterMode = 0
.AutoFilter 11, "#n/a"
.Columns(8).Offset(1).SpecialCells(12).Copy Sheets("Partial default order").[a1]
.Columns(3).Offset(1).SpecialCells(12).Copy Sheets("Partial default order").[b1]
.Columns(4).Offset(1).SpecialCells(12).Copy Sheets("Partial default order").[d1]
.Columns(2).Offset(1).SpecialCells(12).Copy Sheets("Partial default order").[e1]
.Columns(9).Offset(1).SpecialCells(12).Copy Sheets("Partial default order").[f1]
.Offset(1).SpecialCells(12).EntireRow.Delete
.AutoFilter 11
.Parent.AutoFilterMode = 0
End With
With Sheets("Report").UsedRange
.Parent.AutoFilterMode = 0
.Columns(8).Offset(1).SpecialCells(12).Copy Sheets("Acts of acceptance").[a1]
.Columns(3).Offset(1).SpecialCells(12).Copy Sheets("Acts of acceptance").[b1]
.Columns(4).Offset(1).SpecialCells(12).Copy Sheets("Acts of acceptance").[d1]
.Columns(2).Offset(1).SpecialCells(12).Copy Sheets("Acts of acceptance").[e1]
.Columns(9).Offset(1).SpecialCells(12).Copy Sheets("Acts of acceptance").[f1]
.Parent.AutoFilterMode = 0
End With
Windows("Аномалії приймання в заданий період.xls").Activate
Dim FaCom1(), FaCom2(), ParOrd1(), ParOrd2(), Act1(), Act2()
Application.ScreenUpdating = False
Windows("Основний готовий звіт.xls").Activate
FaCom1 = Sheets("Failure to complete order").Range("A1").CurrentRegion.Value
FaCom2 = Sheets("Failure to complete order").Range("D1").CurrentRegion.Value
ParOrd1 = Sheets("Partial default order").Range("A1").CurrentRegion.Value
ParOrd2 = Sheets("Partial default order").Range("D1").CurrentRegion.Value
Act1 = Sheets("Acts of acceptance").Range("A1").CurrentRegion.Value
Act2 = Sheets("Acts of acceptance").Range("D1").CurrentRegion.Value
'''''' '''''' '''''' '''''' '''''' '''''' ''''''
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
'''''' '''''' '''''' '''''' '''''' '''''' ''''''
Windows("Аномалії приймання в заданий період.xls").Activate
With Sheets("Звіт")
.Cells(2, 1).Resize(UBound(FaCom1), UBound(FaCom1, 2)) = FaCom1
.Cells(2 + UBound(FaCom1), 1).Resize(UBound(ParOrd1), UBound(ParOrd1, 2)) = ParOrd1
.Cells(2 + UBound(FaCom1) + UBound(ParOrd1), 1).Resize(UBound(Act1()), UBound(Act1(), 2)) = Act1()
.Cells(2, 4).Resize(UBound(FaCom2), UBound(FaCom2, 2)) = FaCom2
.Cells(2 + UBound(FaCom2), 4).Resize(UBound(ParOrd2), UBound(ParOrd2, 2)) = ParOrd2
.Cells(2 + UBound(FaCom2) + UBound(ParOrd2), 4).Resize(UBound(Act2()), UBound(Act2(), 2)) = Act2()
.Cells(2, 7).Resize(UBound(FaCom1)).Value = 23
.Cells(2 + UBound(FaCom1), 7).Resize(UBound(ParOrd1)).Value = 42
.Cells(2 + UBound(FaCom1) + UBound(ParOrd1), 7).Resize(UBound(Act1)).Value = 43
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
Windows("PA_command_recep_par_CM_New.xls").Close False
Application.CutCopyMode = False
Windows("Основний готовий звіт.xls").Close False
End Sub
