Макрос копирование ячеек при условии жирного шрифта

[IgorGO]

и с учетом последнего файла (отдел 1, сектор 2)

    If rg2.Row - rg1.Row > 1 then Cells(rg1.Row + 1, 1).Resize(rg2.Row - rg1.Row - 1, 1).Value = rg1.Value

исправления, то минимальные надо было сделать...

[Hugo121]

Я нигде не писал, что нужно выделять столбец! Выделайте диапазон - ЧАСТЬ столбца.
Ну а вообще можно код в этой части доработать, чтоб сам находил нужный диапазон.

Option Explicit

Sub tt()
    Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Range([b2], Cells(Rows.Count, "B").End(xlUp)).Cells
        If c.Font.Bold = False And c.Offset(, 1).Font.Bold = False Then
            With c.Offset(, -1)
                Select Case True
                Case Len(c.Offset(-1, -1)): .Value = c.Offset(-1, -1)
                Case Len(c.Offset(-1, 0)): .Value = c.Offset(-1, 0)
                Case Len(c.Offset(-1, 1)): .Value = c.Offset(-1, 1)
                End Select
                .Font.Bold = True
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[АннаСаратов1994]

вот это прям сам вырезка из документа...сейчас попробую сделать по Вашим рекомендациям...Спасибо!

[АннаСаратов1994]

Hugo121, сработал Ваш макрос!!!! последний вопрос (извините, пожалуйста, что так Вас мучаю...) как мне подпраивть в макросе - искать не в двух столбцах, а в из четырех...

IgorGO и Hugo121, огромное Вам спасибо за помощь! Очень очень меня выручили!

[Hugo121]

Не, мне мой код переписывать под всё новое изменившееся уже некогда... После праздников если только...
С наступающим!

[IgorGO]

а если после последней должности добавить фиктивное название отдела (любую дурацкую надпись жирным шрифтом) то и последний пропишется.