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

[Hugo121]

Нет, сейчас не могу - работа...

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

Хорошо... Всё равно благодарна за помощь - что уделили время!

[IgorGO]

пробуйте этот

Sub AddSector()
  Dim rg1 As Range, rg2 As Range, frstadr As String
  Application.FindFormat.Clear:  Application.FindFormat.Font.FontStyle = "Bold"
  Set rg1 = Range("B:C").Cells(1)
  Set rg2 = Range("B:C").Find("*", rg1, searchorder:=xlByRows, searchformat:=True)
  If rg2 Is Nothing Then Exit Sub Else frstadr = rg2.Address
  Do
    Set rg1 = rg2
    Set rg2 = Range("B:C").Find("*", rg1, searchorder:=xlByRows, searchformat:=True)
    If rg2.Address = frstadr Then Exit Sub
    Cells(rg1.Row + 1, 1).Resize(rg2.Row - rg1.Row - 1, 1).Value = rg1.Value
  Loop
End Sub

названия секторов (отделов) могут находиться в колонке В или С. просто запустите макрос. возможно, вручную потребуется вставить название последнего сектора.

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

IgorGO, огромное Вам спасибо! всё работает! Спасибо!
Подскажите, пожалуйста, при смене столбцов я меняю в макросе только название столбцов? просто у меня таблича больше, и когда я подставляю макрос в свою таблицу и меняю столбцы с Range("B:C") на Range("D:E"), то выдаёт ошибку, а когда свои данные копирую в пример, то всё работает отлично!
Огромнейшее вам спасибо за помощь!...
ВОт бы научиться так писать макросы- тогда бы цены бы мне было)

[IgorGO]

вот так ошибок не должно быть, можут не проставиться данные для 1-го и последнего секторов. колонок с названиями секторов может быть много (не обязательно 2)

Sub AddSector()
  Dim rg1 As Range, rg2 As Range, rgData As Range
  Application.FindFormat.Clear:  Application.FindFormat.Font.FontStyle = "Bold"
  Set rgData = Range("B:C"):  Set rg1 = rgData.Cells(1)
  Set rg2 = rgData.Find("*", rg1, searchorder:=xlByRows, searchformat:=True)
  If rg2 Is Nothing Then Exit Sub
  Do
    Set rg1 = rg2
    Set rg2 = rgData.Find("*", rg1, searchorder:=xlByRows, searchformat:=True)
    If rg2.Row < rg1.Row Then Exit Sub
    Cells(rg1.Row + 1, 1).Resize(rg2.Row - rg1.Row - 1, 1).Value = rg1.Value
  Loop
End Sub

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

IgorGO, ошибка возникает на стыке жирных ячеек, т.е. когда в столбце B стоит значение жирным шрифтом, потом C в котром также жирный шрифт...
Я могу ручную что то придумать, у меня выгрузка из 20.000 строк, получится очень трудоёмко...

[Hugo121]

И чегож мой код не попробовать?

[IgorGO]

предполагалось:
есть названия секторов (отделов)
в каждом секторе есть минимум 1 должность

если исходные данные имеют другую структуру - покажите ее (как могут выглядеть исходные) соответсвенно макрос видоизмениться немного

[IgorGO]

в конце концов, есть макрос Hugo121.

понимаете, тут как перед доктором, не надо стесняетесь показать "кривые" данные, ну... какие есть
а без полноты картины - и дианоз не точный, и лечение неправильное, и результаты плачевные

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

Hugo121,у меня Ваш макрос не срабатывает.... Копирую макрос, выделяю столбец и запускаю макрос, но ни чего не происходит...