Копируем определенную строку (ячейку) при условии её пометки в Excel VBA

Если нужно работать с определенной таблицей Excel, где имеется шаблон данных и из него часто нужно что-то куда-то копировать, то этот процесс можно автоматизировать. Так же пустые ячейки в этом шаблоне можно заполнять данными и копировать целый диапазон со всеми данными.

У меня была таблица с номенклатурой, в виде внутренней накладной, в которой было много позиций. Когда ко мне приходил монтажник, я выдавал некоторые позиции оборудования из этой таблицы, затем отмечал строку галочкой, чтобы она копировалась в отдельную таблицу - отчет о выданном оборудовании:

Данные помеченные галочкой напротив строки, скопировались в другой документ Excel:

Последняя ячейка с суммой 29621,4 была скопирована из ячейки, где прописана формула суммы.

Код VBA с комментариями

01Сначала надо сделать такую фишку, чтобы при нажатии на ячейку в последнем столбце "Наличие", она выделялась галочкой и копировалась вся строка. В VBA на листе создаем функцию:

Сам код:

 'CODE 1 Ставим флажок, если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("M16:M51")) Is Nothing Then
            Target.Font.Name = "Marlett"
            If Target = vbNullString Then
                Target = "a"
            Else
                Target = vbNullString
            End If
        End If
End Sub
 'CODE 2 Снимаем флажок, если был еще один щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("M16:M51")) Is Nothing Then
        Cancel = True 'Prevent going into Edit Mode
        Target.Font.Name = "Marlett"
            If Target = vbNullString Then
                Target = "a"
            Else
                Target = vbNullString
            End If
    End If
End Sub

02Теперь создаем модуль, который будет копировать строки, где поставили галочку. Данные копируются в последние пустые строки таблицы в другом документе на определенную страницу:

Сам код:

'АНДРОМЕДА**********************************************************************
'********************КОПИРОВАНИЕ В ОБЩУЮ ПО МОНТАЖАМ****************************
'*******************************************************************************
Sub Копируем_листы_в_ОБЩУЮ_МОНТАЖИ()
Dim bookconst As Workbook
Dim rg As Range
Dim iLastRow As Long
'Dim LastRow As Long
Dim abook As Workbook
 'Больше не обновляем страницы после каждого действия
  Application.ScreenUpdating = False
'присваиваем переменную активной книге
Set abook = ActiveWorkbook
'присваиваем перменную книге куда необходимо копировать данные 'переменная для 2-й книги
Set bookconst = Workbooks.Open("S:\Рабочий стол\СКЛАД\ТАБЛИЦЫ БАЛАНСОВ\2017\Общая информация по оборудованию за 2017.xlsm")
'определяем последнюю строку по 7 заполненному столбцу
iLastRow = bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Row
'копируем Наименование объекта
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 2).Value = abook.Worksheets("Лист1").Cells(10, 4).Value
'копируем адрес
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 3).Value = abook.Worksheets("Лист1").Cells(10, 8).Value
'копируем пульт номер
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 4).Value = abook.Worksheets("Лист1").Cells(8, 13).Value
'копируем дату
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 5).Value = abook.Worksheets("Лист1").Cells(2, 7).Value
'копируем причину
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 6).Value = abook.Worksheets("Лист1").Cells(8, 9).Value
'активируем исходный
abook.Worksheets("Лист1").Activate
'Наименование оборудования по выставленной галочке 16 строка
For Each rg In Range("M16")
        If rg = "a" Then 'если значение в ячейке = "а"
abook.Worksheets("Лист1").Cells(16, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(16, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(16, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B16:M16").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 17 строка
For Each rg In Range("M17")
        If rg = "a" Then 'если значение в ячейке = "a"
abook.Worksheets("Лист1").Cells(17, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(17, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(17, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B17:M17").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 18 строка
For Each rg In Range("M18")
        If rg = "a" Then 'если значение в ячейке = "a"
abook.Worksheets("Лист1").Cells(18, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(18, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(18, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B18:M18").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 19 строка
For Each rg In Range("M19")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(19, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(19, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(19, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B19:M19").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 20 строка
For Each rg In Range("M20")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(20, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(20, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(20, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B20:M20").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 21 строка
For Each rg In Range("M21")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(21, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(21, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(21, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B21:M21").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 22 строка
For Each rg In Range("M22")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(22, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(22, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(22, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B22:M22").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 23 строка
For Each rg In Range("M23")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(23, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(23, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(23, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B23:M23").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 24 строка
For Each rg In Range("M24")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(24, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(24, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(24, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B24:M24").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 25 строка
For Each rg In Range("M25")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(25, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(25, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(25, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B25:M25").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 26 строка
For Each rg In Range("M26")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(26, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(26, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(26, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B26:M26").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 27 строка
For Each rg In Range("M27")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(27, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(27, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(27, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B27:M27").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 28 строка
For Each rg In Range("M28")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(28, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(28, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(28, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B28:M28").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 29 строка
For Each rg In Range("M29")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(29, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(29, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(29, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B29:M29").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 30 строка
For Each rg In Range("M30")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(30, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(30, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(30, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B30:M30").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 31 строка
For Each rg In Range("M31")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(31, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(31, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(31, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B31:M31").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 32 строка
For Each rg In Range("M32")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(32, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(32, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(32, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B32:M32").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 33 строка
For Each rg In Range("M33")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(33, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(33, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(33, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B33:M33").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 34 строка
For Each rg In Range("M34")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(34, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(34, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(34, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B34:M34").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 35 строка
For Each rg In Range("M35")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(35, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(35, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(35, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B35:M35").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 36 строка
For Each rg In Range("M36")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(36, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(36, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(36, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B36:M36").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 37 строка
For Each rg In Range("M37")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(37, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(37, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(37, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B37:M37").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 38 строка
For Each rg In Range("M38")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(38, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(38, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(38, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B38:M38").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 39 строка
For Each rg In Range("M39")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(39, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(39, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(39, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B39:M39").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 40 строка
For Each rg In Range("M40")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(40, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(40, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(40, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B40:M40").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 41 строка
For Each rg In Range("M41")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(41, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(41, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(41, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B41:M41").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 42 строка
For Each rg In Range("M42")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(42, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(42, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(42, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B42:M42").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 43 строка
For Each rg In Range("M43")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(43, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(43, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(43, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B43:M43").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 44 строка
For Each rg In Range("M44")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(44, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(44, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(44, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B44:M44").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 45 строка
For Each rg In Range("M45")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(45, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(45, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(45, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B45:M45").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 46 строка
For Each rg In Range("M46")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(46, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(46, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(46, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B46:M46").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 47 строка
For Each rg In Range("M47")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(47, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(47, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(47, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B47:M47").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 48 строка
For Each rg In Range("M48")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(48, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(48, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(48, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B48:M48").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 49 строка
For Each rg In Range("M49")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(49, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(49, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(49, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B49:M49").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 50 строка
For Each rg In Range("M50")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(50, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(50, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(50, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B50:M50").Select
    Selection.Font.Bold = True
End If
Next
'Следующее Наименование оборудования 51 строка
For Each rg In Range("M51")
        If rg = "a" Then 'если значение в ячейке = "отдел"
abook.Worksheets("Лист1").Cells(51, 5).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 7).End(xlUp).Offset(1)
'там же кол-во
abook.Worksheets("Лист1").Cells(51, 10).Copy bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 8).End(xlUp).Offset(1)
'там же Стоимость единицы оборудования
abook.Worksheets("Лист1").Cells(51, 11).Copy
Application.DisplayAlerts = False
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial _
        Paste:=xlPasteValues
        'Делаем жирным всю строку после копирования в исходном
    Range("B51:M51").Select
    Selection.Font.Bold = True
End If
Next
 'Копируем общую сумму ЗДЕСЬ в конце
bookconst.Worksheets("Декабрь 2017 Монтаж").Cells(iLastRow + 1, 11).Value = abook.Worksheets("Лист1").Cells(52, 12).Value
'активируем конечную книгу
bookconst.Activate
'сохраняем
bookconst.Save
'сообщение на экран
MsgBox "Скопировано и сохранено в ОБЩЕЙ по балансам МОНТАЖЕЙ!"
End Sub

*Названия листов, путь для копирования в книгу, диапазон имен ячеек меняем на свои.

Конечно это можно сделать более сложными функциями, но сделал так, чтобы можно было через некоторое время вносить правки сильно не вникая в код. Так с помощью Excel VBA будут копироваться определенные строки, которые пометили галочкой в другую книгу Excel, в последние пустые строки.

mr. Mak

Остались вопросы? Пишите на почту admin@hzit.ru

Администратор сайта hzit.ru
Back to top