Sub Поиск_и_копирование()

'Поиск организационных операций, удовлетворяющих условию,
'и их копирование по порядку на новый лист

Dim x As Integer, y As Integer, z As Integer
Dim i As Integer, g As Integer, k As Integer
k = 1
Sheets("Лист3").Activate
Sheets("Лист2").Activate
'Задание переменной g, равной кол-ву организационноых операций
Set myRange = Worksheets("Лист2").Range("A:A")
g = WorksheetFunction.Max(myRange)
'Задание переменной i, равной кол-ву строк с заполненными графами
'таблицы с Неделимыми операциями
Set myRange2 = Worksheets("Лист2").Range("B:B")
i = WorksheetFunction.Max(myRange2) + 4
'z - это первая строка на Листе3, куда вводятся данные
'y - это первая строка таблицы Неделимых операций с заполненными
'графами
z = 1
y = 5

For x = 1 To g
Sheets("Лист3").Activate
  ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(z, 1), Cells(z, 11)), , xlNo).Name _
= "Таблица" & k
  
 ActiveSheet.Cells(z, 1).Select
ActiveCell.FormulaR1C1 = x
Sheets("Лист2").Activate
For y = 5 To i
If x = Sheets("Лист2").Cells(y, 1).Value Then
Sheets(2).Select
Set Rng = Sheets(2).Range(Cells(y, 2), Cells(y, 10))
Rng.Copy
Sheets("Лист3").Activate
Range(Cells(z, 2), Cells(z, 10)).PasteSpecial Paste:=xlPasteValues
Rows(z).RowHeight = 50

z = z + 1
Else: End If
Next y
   Range("Таблица" & k & "[#Headers]").Select
    If k = 1 Then
   z = z + 1
Else
Selection.EntireRow.Hidden = True
z = z + 1
End If

    'Создание строки итогов в полученной таблице
ActiveSheet.ListObjects("Таблица" & k).ShowTotals = True
      Rows(z).RowHeight = 50
          Cells(z, 1).Select
    ActiveSheet.HPageBreaks.Add Before:=ActiveCell
    k = k + 1
Next x
End Sub

Sub Сумма()
Dim lLastRow As Integer
Sheets("Шаблон").Activate

lLastRow = Cells(Rows.Count, 4).End(xlUp).Row

Cells(lLastRow + 1, 4).Formula = "=СУММ(" & "D2:D" & lLastRow & ")"

End Sub

Dim x As Integer, y As Integer, z As Integer
Dim i As Integer, g As Integer, k As Integer
k = 1
'Создание таблицы на Листе3
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$K$11"), , xlNo).Name _
= "Таблица1"

Sheets("Лист2").Activate
'Задание переменной g, равной кол-ву организационных операций
Set myRange = Worksheets("Лист2").Range("A:A")
g = WorksheetFunction.Max(myRange)
'Задание переменной i, равной кол-ву строк с заполненными графами
'таблицы с Неделимыми операциями
Set myRange2 = Worksheets("Лист2").Range("B:B")
i = WorksheetFunction.Max(myRange2) + 4
'z - это первая строка на Листе3, куда вводятся данные
'y - это первая строка таблицы Неделимых операций с заполненными
'графами
z = 2
y = 5

For x = 1 To 5
Sheets("Лист3").Activate
ActiveSheet.Cells(z, 1).Select
ActiveCell.FormulaR1C1 = x
Sheets("Лист2").Activate
For y = 5 To i
If x = Sheets("Лист2").Cells(y, 1).Value Then
Sheets(2).Select
Set Rng = Sheets(2).Range(Cells(y, 2), Cells(y, 10))
Rng.Copy
Sheets("Лист3").Activate
Range(Cells(z, 2), Cells(z, 10)).PasteSpecial Paste:=xlPasteValues
Rows(z).RowHeight = 50
z = z + 1
Else: End If
Next y

'Создание строки итогов в полученной таблице
ActiveSheet.ListObjects("Таблица" & k).ShowTotals = True
 ActiveSheet.ListObjects("Таблица" & k).ListColumns( _
        "Норма времени на изделие, сек.").TotalsCalculation = xlTotalsCalculationSum
      ActiveSheet.ListObjects("Таблица" & k).ListColumns( _
        " Расценка на единицу изд. кол.").TotalsCalculation = xlTotalsCalculationSum
        Sheets("Лист3").Range("Таблица" & k & "[[#Totals],[Норма выработки ед/см]]").Select
ActiveCell.FormulaR1C1 = "=24012/Таблица" & k & "[[#Totals],[Норма времени на изделие, сек.]]"
 Range("Таблица" & k & "[[#Totals],[ Кол-во раб. расч.]]").Select
    ActiveCell.FormulaR1C1 = _
        "=Таблица" & k & "[[#Totals],[Норма времени на изделие, сек.]]/Лист1!R2C9"
    Range("Таблица" & k & "[[#Totals],[Оборудование , приспособления, инструмент]]").Select
    Selection.ClearContents
    Range("Таблица" & k & "[[#Totals],[Кол-во раб. факт]]").Select
    ActiveCell.FormulaR1C1 = "=ROUND(Таблица" & k & "[[#Totals],[ Кол-во раб. расч.]],0)"
    Range("Таблица" & k & "[[#Totals],[№ организ. операции]]").Select
    Selection.ClearContents
  
     
     Rows(z).RowHeight = 50
        z = z + 1
          Cells(z, 1).Select
    ActiveSheet.HPageBreaks.Add Before:=ActiveCell
     k = k + 1
       
   'Создание таблицы следующей организационной операции на Листе3
    ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(z, 1), Cells(z, 11)), , xlNo).Name _
= "Таблица" & k
Range("Таблица" & k & "[#Headers]").Select    Selection.EntireRow.Hidden = True
z = z + 1
Next x

End Sub