Option Explicit

Sub Сформировать()

    Dim shSrc As Worksheet, shRes As Worksheet, arr()
    Dim lr As Long, i As Long
    
    Application.ScreenUpdating = False
    
    Set shSrc = ActiveSheet
    Set shRes = Worksheets("Прайс лист")
    
    If shRes.UsedRange.Rows.Count > 1 Then
        shRes.Rows("2:" & shRes.UsedRange.Rows.Count).Delete
    End If
    
    lr = shSrc.Columns("B").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    
    shRes.Range("A2:B" & lr).Value = shSrc.Range("B2:C" & lr).Value
    shRes.Range("C2:H" & lr).Value = shSrc.Range("I2:N" & lr).Value
    
    shRes.Sort.SortFields.Clear
    shRes.Sort.SortFields.Add Key:=shRes.Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending
    With shRes.Sort
        .SetRange shRes.Range("A1:H" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    Application.Goto shRes.Range("A1")
    shSrc.Select
    
    lr = shRes.Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = shRes.Range("A1:B" & lr).Value
    
    shRes.Range("A2").Value = 1
    shRes.Range("A2:A" & lr).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    
    For i = UBound(arr, 1) To 2 Step -1
        If arr(i, 1) <> arr(i - 1, 1) Then
            shRes.Rows(i).Insert
            shRes.Cells(i, "A").Resize(1, 8).Interior.Color = 3243501
            shRes.Cells(i, "B").Font.Color = 16777215
            shRes.Cells(i, "B").Value = arr(i, 1)
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово", vbInformation

End Sub

Private Sub CommandButton1_Click()
 EmptyRows = WorksheetFunction.CountA(Range("B:B")) + 1

If ComboBox1.ListIndex = -1 Then Worksheets("Породы гнезда").Cells(Worksheets("Породы гнезда").Cells(Rows.Count, "B1:B").End(xlUp).Row + 1, "B").Value = ComboBox1.Value
 Cells(EmptyRows, 2) = ComboBox1.Value

If ComboBox2.ListIndex = -1 Then Worksheets("Окрасы").Cells(Worksheets("Окрасы").Cells(Rows.Count, "C1:C").End(xlUp).Row + 1, "C").Value = ComboBox2.Value
 Cells(EmptyRows, 3) = ComboBox2.Value

If ComboBox3.ListIndex = -1 Then Worksheets("Породы гнезда").Cells(Worksheets("Породы гнезда").Cells(Rows.Count, "D1:D").End(xlUp).Row + 1, "D").Value = ComboBox3.Value
 Cells(EmptyRows, 4) = ComboBox3.Value
 Cells(EmptyRows, 5) = TextBox1.Value 'дата'
 Cells(EmptyRows, 6) = TextBox2.Value 'количество голов'
 Cells(EmptyRows, 7) = TextBox3.Value 'из них кур'
 Cells(EmptyRows, 8) = TextBox2.Value - TextBox3.Value
 Cells(EmptyRows, 9) = TextBox4.Value  'инкубационное яйцо'
 Cells(EmptyRows, 10) = TextBox5.Value 'суточные цыплята'
 Cells(EmptyRows, 11) = TextBox5.Value + 50 'недельные цыплята'
 Cells(EmptyRows, 12) = TextBox5.Value + 100 'двухнедельные цыплята'
 Cells(EmptyRows, 13) = TextBox5.Value + 150 'трехнедельные цыплята'
 Cells(EmptyRows, 14) = TextBox5.Value + 200 'месячные цыплята'
 Cells(EmptyRows, 15) = TextBox5.Value + 400 'двухмесячные цыплята'
 Cells(EmptyRows, 16) = TextBox5.Value + 600 'трехмесячные цыплята'
 Cells(EmptyRows, 17) = TextBox5.Value + 800 'четырехмесячные цыплята'
 UserForm_Initialize
End Sub

Private Sub CommandButton2_Click()
Call UserForm_Initialize
End Sub

Private Sub CommandButton3_Click()
 UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()

 ComboBox1.Clear: ComboBox1.Text = ""

For I = 1 To Worksheets("Породы гнезда").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox1.AddItem Worksheets("Породы гнезда").Cells(I, "A").Value
Next I

 ComboBox2.Clear: ComboBox2.Text = ""

For I = 1 To Worksheets("Окрасы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox2.AddItem Worksheets("Окрасы").Cells(I, "A").Value
Next I

 ComboBox3.Clear
For I = 1 To Worksheets("Породы гнезда").Cells(Rows.Count, "B").End(xlUp).Row
 ComboBox3.AddItem Worksheets("Породы гнезда").Cells(I, "B").Value
Next I
 TextBox1.Text = Format(Now(), "dd.mm.yyyy") 'дата'
 TextBox2.Value = "" 'количество голов'

 TextBox3.Value = "" 'из них кур'

 TextBox4.Value = "" 'цена инкубационного яйца'

 TextBox5.Value = "" 'цена суточного цыпленка'

End Sub

Private Sub CommandButton1_Click()
EmptyRows = WorksheetFunction.CountA(Range("B:B")) + 1
Cells(EmptyRows, 2) = ComboBox1.Value
Cells(EmptyRows, 3) = ComboBox2.Value
Cells(EmptyRows, 4) = ComboBox3.Value
Cells(EmptyRows, 5) = TextBox3.Value
Cells(EmptyRows, 6) = TextBox4.Value
Cells(EmptyRows, 7) = TextBox5.Value
Cells(EmptyRows, 9) = TextBox7.Value
Cells(EmptyRows, 10) = TextBox8.Value
Cells(EmptyRows, 11) = TextBox8.Value + 50
Cells(EmptyRows, 12) = TextBox8.Value + 100
Cells(EmptyRows, 13) = TextBox8.Value + 150
Cells(EmptyRows, 14) = TextBox8.Value + 200
Cells(EmptyRows, 15) = TextBox8.Value + 400
Cells(EmptyRows, 16) = TextBox8.Value + 600
End Sub

ComboBox1.Clear
For I = 1 To Worksheets("Породы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox1.AddItem Worksheets("Породы").Cells(I, "A").Value
Next I

 ComboBox2.Clear
For I = 1 To Worksheets("Окрасы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox2.AddItem Worksheets("Окрасы").Cells(I, "A").Value
Next I

 ComboBox3.Clear
For I = 1 To Worksheets("Породы").Cells(Rows.Count, "B").End(xlUp).Row
 ComboBox3.AddItem Worksheets("Породы").Cells(I, "B").Value
Next I

Sub ()
Application.ScreenUpdating = False
Application.CutCopyMode = False
iLastA = Worksheets("List2").Cells(Rows.Count, 1).End(xlUp).Row + 1
iLastB = Worksheets("List2").Cells(Rows.Count, 2).End(xlUp).Row + 1
iLastC = Worksheets("List2").Cells(Rows.Count, 3).End(xlUp).Row + 1

Worksheets("List1").Range("B1:B39").Copy
Worksheets("List2").Range("A" & iLastA).PasteSpecial xlValue
Worksheets("List1").Range("C1:C39").Copy
Worksheets("List2").Range("B" & iLastB).PasteSpecial xlValue
Worksheets("List1").Range("I1:I39").Copy
Worksheets("List2").Range("C" & iLastC).PasteSpecial xlValue
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub