ActiveWorkbook.Worksheets("Инф. Заказчик").Range("A1:C16").Copy
    Workbooks("Книга1.xlsm").Worksheets("Инф. Заказчик").Range("A1").PasteSpecial xlPasteValues
    ActiveWorkbook.Worksheets("Инф. Заказчик").Range("G7").Copy
    Workbooks("Книга1.xlsm").Worksheets("Инф. Заказчик").Range("G7").PasteSpecial xlPasteValues
    ActiveWorkbook.Worksheets("Расчет выброса").Range("A1:C25").Copy
    Workbooks("Книга1.xlsm").Worksheets("Расчет выброса").Range("A1").PasteSpecial xlPasteValues

Function Range_Diff( _
    range_1 As Range, _
    ramge_2 As Range) _
    As Range

    Dim _
        range_Inter As Range, _
        range_Union As Range, _
        range_Accum As Range, _
        cell As Range

    With Application
        
        Set range_Inter = .Intersect(range_1, ramge_2)
        Set range_Union = .Union(range_1, ramge_2)

        For Each cell In range_Union
  
            If .Intersect(range_Inter, cell) Is Nothing Then
  
                Set range_Accum = App_Union(range_Accum, cell)
  
            End If
        Next
    End With
  
    Set Range_Diff = range_Accum
  
End Function

Function App_Union(rng_Union As Range, _
    rng As Range) _
    As Range
    ' procedure Checked by test
    ' в обычном Application.Union Method At least two Range objects must be specified.
    ' в нашем и 2, и 1, и 0

    If Not rng_Union Is Nothing Then

        If Not rng Is Nothing Then

            Set App_Union = Application.Union( _
                rng_Union, rng)

        Else

            Set App_Union = rng_Union

        End If
    Else

        Set App_Union = rng

    End If
End Function

'разработка от: bvv(bedvit)-Виталий Б.
'для форума: http://www.planetaexcel.ru/forum
'действие: Перевести условное форматирование в обычное (выделенный диапазон), если выделена одна ячейка - обрабатывается весь лист.
'сохраняет структуру/группировку листа.
Sub FormatConditions_2_Ordinary( _
  wSh As Worksheet)

'  If MsgBox("Форматы не входящие в стандартные (гистограммы и значки), будут утеряны! Продолжить?", vbExclamation + vbYesNo) = vbYes Then
  
  Dim W As String, S As String, tW As String, Rn As Range, ac, R As Range, A As Long
    W = wSh.Parent.Name: S = wSh.Name
    Err.Clear: On Error Resume Next 'обработка ошибок в случае отсутствия условнного формата на листе
    If Selection.CountLarge = 1 Then Set Rn = Cells.SpecialCells(xlCellTypeAllFormatConditions) Else Set Rn = Selection.SpecialCells(xlCellTypeAllFormatConditions)
    If Rn Is Nothing Or Err > 0 Then Exit Sub
    For A = 1 To Rn.Areas.Count
      Set R = Rn.Areas(A)
      Randomize: tW = Environ("temp") & "\~$CF" & Int((1000000000 * Rnd) + 1000000000) & ".mht"
      If R.Columns.Count = ActiveSheet.Columns.Count Or R.Rows.Count = ActiveSheet.Rows.Count Then ' если сохраняем структуру
        Sheets(S).Copy
        ActiveWorkbook.SaveAs filename:=tW, FileFormat:=xlWebArchive, CreateBackup:=False
        ActiveWorkbook.Close 0
        Workbooks.Open filename:=tW
        Range(R(1, 1).address, R(R.Rows.Count, R.Columns.Count).address).Copy:  Workbooks(W).Sheets(S).Range(R(1, 1).address, R(R.Rows.Count, R.Columns.Count).address).PasteSpecial Paste:=xlPasteFormats
      Else
        With ActiveWorkbook.PublishObjects.Add(xlSourceRange, tW, S, R.address, xlHtmlStatic, W, ""): .Publish (True): .AutoRepublish = False: End With
        Workbooks.Open filename:=tW
        Range(Cells(1, 1), Cells(R.Rows.Count, R.Columns.Count)).Copy:  Workbooks(W).Sheets(S).Range(R(1, 1).address, R(R.Rows.Count, R.Columns.Count).address).PasteSpecial Paste:=xlPasteFormats
      End If
      Application.CutCopyMode = False
      ActiveWorkbook.Close 0: Kill tW
      R.Select: R.FormatConditions.Delete
    Next
    Rn.Select
End Sub

Function Google_Translate_Eng_2_Rus( _
        ByVal msg As String, _
        Optional volatile As Boolean = False) _
        As String
    ' перевод работает

    If volatile Then Application.volatile

    Static oHttp As Object
    If oHttp Is Nothing Then Set oHttp = CreateObject("MSXML2.XMLHTTP")

    Dim URL As String, _
            STR As String, _
            translate As String, _
            N As Long, _
            K As Long

    '    msg = Replace(LTrim(RTrim(msg)), " ", "%20")
    msg = Replace(Trim(msg), " ", "%20")

    URL = "https://www.google.ru/async/translate?vet=12ahUKEwiKgq2y4YnmAhVCw4sKHXwUArIQqDgwAHoECAsQHw..i&ei=QBfeXYriG8KGrwT8qIiQCw&yv=3"
    With oHttp
        .Open "POST", URL, False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded;charset=UTF-8"
        .send "async=translate,sl:en,tl:ru,st:" & msg & ",id:1574836225475,qc:true,ac:true,_id:tw-async-translate,_pms:s,_jsfs:Ffpdje,_fmt:pc"
        
        If .Status = 200 Then
            STR = .responseText
            N = InStr(1, STR, "target-text"">") + 13
            K = InStr(N, STR, "</span>")

            Google_Translate_Eng_2_Rus = Mid(STR, N, K - N)

        End If
    End With
End Function