Вот моя первая тема:
Шеф поставил задачу облегчить заполнение и оформление накладных по отправке деталей на обработку в сторонние организации. Вот что я накропал, сообразуясь со своими пока очень малыми знаниями в VBA.
Алгоритм: В Листе Перечень при помощи комбобокса осуществляется поиск необходимых деталей( продуктов) направляемых на переработку( изготовление)в столбцах отправление или приход ставится количеств деталей на отправку или пришедших. Данное количество автоматически переносится соответственно на листы отправка или приход( формируется накладная), где по нажатии кнопки накладная сохраняется и распечатывается. Количество копий указывается в ячейке К1(зеленого цвета)
ВАЖНО: графа Примечание заполняется ДО заполнения граф отправка или приход
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = False
Dim Lr As Long
Dim Lr1 As Long
Dim Lr2 As Long
Dim trw As Long
Dim trs As Long
If Target.Count > 1 Then Exit Sub
Lr = Sheets("Перечень").Cells(Rows.Count, 1).End(xlUp).Row
Lr1 = Sheets("Отправка").Cells(Rows.Count, 1).End(xlUp).Row
Lr2 = Sheets("Получение").Cells(Rows.Count, 1).End(xlUp).Row
If Intersect(Target, Range("E2:F" & Lr)) Is Nothing Then Exit Sub
trw = Target.Row
trs = Target.Column
If trs = 5 Then
If Range("E" & trw) = "" Then Exit Sub
Sheets("Перечень").Range("A" & trw & ":E" & trw & "," & "G" & trw).Copy
Sheets("Отправка").Range("A" & Lr1 + 1).PasteSpecial Paste:=xlPasteValues
Sheets("Отправка").Range("A" & Lr1 + 1 & ":F" & Lr1 + 1).Borders.LineStyle = xlContinuous
Sheets("Отправка").Rows(Lr1 + 2).Insert Shift:=xlDown
Else
If Range("F" & trw) = "" Then Exit Sub
Range("A" & trw & ":D" & trw & "," & "F" & trw & ":G" & trw).Copy
Sheets("Получение").Range("A" & Lr2 + 1).PasteSpecial Paste:=xlPasteValues
Sheets("Получение").Range("A" & Lr2 + 1 & ":F" & Lr2 + 1).Borders.LineStyle = xlContinuous
Sheets("Получение").Rows(Lr2 + 2).Insert Shift:=xlDown
End If
Application.ScreenUpdating = True
Application.CutCopyMode = True
Application.DisplayAlerts = True
End Sub