Private Sub Command1_Click()

         Dim objExcel, objWorkbook
         Set objExcel = CreateObject("EXCEL.APPLICATION")
             objExcel.Visible = False
'Ïóòü ê èñõîäíîìó ôàéëó
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\Varina_LI\Desktop\ïðèìåð\ms21.xlsx")

Dim d As Long
Application.ScreenUpdating = False
        Dim shSrc As Worksheet, shRes As Worksheet
        Dim lrRes As Long
        Dim New_Wb As Workbook
        Dim i As Integer
        Dim x As Integer
        Dim result As Integer
        Application.ScreenUpdating = False
        Set New_Wb = Workbooks.Add
        New_Wb.Activate
        'Ïóòü ãäå ñîçäàåòñÿ íîâûé ôàéë
        New_Wb.SaveAs FileName:="C:\Users\Varina_LI\Desktop\ïðèìåð\maket17_ms21.xlsx"
        New_Wb.Close True
        Set shSrc = ActiveSheet
        'Äîëæíû ñîâïàäàòü
        Set shRes = Workbooks.Open("C:\Users\Varina_LI\Desktop\ïðèìåð\maket17_ms21.xlsx").Worksheets(1)
        Range("A1") = "MAK"
        Range("B1") = "PACH"
        Range("C1") = "IZ"
        Range("D1") = "MOD"
        Range("E1") = "NSP"
        Range("F1") = "NDT"
        Range("G1") = "SHPR"
        Range("H1") = "KSB"
        Range("I1") = "KIZ"
        Range("J1") = "WES"
        Range("K1") = "SWW"
        Range("L1") = "SOG"
        Range("M1") = "SHP"
        Range("N1") = "EI"
        Range("O1") = "NNM"
        Range("P1") = "NOR"
        Range("Q1") = "GOP"
        Range("R1") = "ZPD"
        Range("S1") = "Z0"
        Range("T1") = "Z1"
        Range("U1") = "Z2"
        Range("V1") = "Z3"
        Range("W1") = "Z4"
        Range("X1") = "Z5"
        Range("Y1") = "NDOC"
        Range("Z1") = "PROB"
        Range("AA1") = "VER"
          
        Rows("1:1").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .WrapText = True
        End With
          
          
         lrRes = shRes.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row + 1
                
        shSrc.Activate
        d = shSrc.Cells(Rows.Count, 5).End(xlUp).Row

        shRes.Range("A2 :A" & d & "") = "17"
        shRes.Range("B2 :B" & d & "") = "001"
        shRes.Range("C2 :C" & d & "") = "2"
        shRes.Range("D2 :D" & d & "") = "11"
        shRes.Range("G2 :G" & d & "") = "11"
        shRes.Range("M2 :M" & d & "") = "00"
        shRes.Range("AA2 :AA" & d & "") = "1"
            
        shSrc.Range("B2:B" & d & "").Copy
        shRes.Cells(lrRes, 5).PasteSpecial xlPasteValues
        shSrc.Range("C2:C" & d & "").Copy
        shRes.Cells(lrRes, 6).PasteSpecial xlPasteValues
        shSrc.Range("J2:J" & d & "").Copy
        shRes.Cells(lrRes, 8).PasteSpecial xlPasteValues
        shSrc.Range("K2:K" & d & "").Copy
        shRes.Cells(lrRes, 9).PasteSpecial xlPasteValues
        shSrc.Range("L2:L" & d & "").Copy
        shRes.Cells(lrRes, 10).PasteSpecial xlPasteValues
        shSrc.Range("N2:N" & d & "").Copy
        shRes.Cells(lrRes, 11).PasteSpecial xlPasteValues
        shSrc.Range("O2:O" & d & "").Copy
        shRes.Cells(lrRes, 12).PasteSpecial xlPasteValues
        shSrc.Range("Y2:Y" & d & "").Copy
        shRes.Cells(lrRes, 14).PasteSpecial xlPasteValues
        shSrc.Range("Z2:Z" & d & "").Copy
        shRes.Cells(lrRes, 15).PasteSpecial xlPasteValues
        shSrc.Range("AC2:AC" & d & "").Copy
        shRes.Cells(lrRes, 16).PasteSpecial xlPasteValues
        shSrc.Range("AI2:AI" & d & "").Copy
        shRes.Cells(lrRes, 17).PasteSpecial xlPasteValues
        shSrc.Range("AJ2:AJ" & d & "").Copy
        shRes.Cells(lrRes, 18).PasteSpecial xlPasteValues
        shSrc.Range("AK2:AK" & d & "").Copy
        shRes.Cells(lrRes, 19).PasteSpecial xlPasteValues
        shSrc.Range("AL2:AL" & d & "").Copy
        shRes.Cells(lrRes, 20).PasteSpecial xlPasteValues
        shSrc.Range("AM2:AM" & d & "").Copy
        shRes.Cells(lrRes, 21).PasteSpecial xlPasteValues
        shSrc.Range("AN2:AN" & d & "").Copy
        shRes.Cells(lrRes, 22).PasteSpecial xlPasteValues
        shSrc.Range("AO2:AO" & d & "").Copy
        shRes.Cells(lrRes, 23).PasteSpecial xlPasteValues
        shSrc.Range("AP2:AP" & d & "").Copy
        shRes.Cells(lrRes, 24).PasteSpecial xlPasteValues

        Application.CutCopyMode = False
        shRes.Parent.Close 1
        Application.ScreenUpdating = True
        MsgBox "Ìàêåò 17 äëÿ ÌÑ21 óñïåøíî ñôîðìèðîâàí"
        objExcel.ActiveWorkbook.Close savechanges:=False
End Sub