Примерно так - копируется целиком строка листа, если целиком не надо то дипазон просто надо копировать (ну или прям ячейкам перебором значения присваивать) Ставьте курсор на столбец с проверямыми значениями и он будет перебир. до первой пустой ячейки.
Public Sub test()
Dim lCnt As Long
Dim lRowCopy As Long ' кол-во скопированных строк
Dim iIndSheet As Integer

i = ActiveSheet.Index + 1 ' получаем индекс след. листа
lCnt = 0
lRowCopy = 0
Do While ActiveCell.Offset(lCnt, 0) <> Empty
If ActiveCell.Offset(lCnt, 0).Font.Bold = True Then ' если шрифт жирный
If lCnt > 0 Then ' есть предыдущая строка
ActiveCell.Offset(lCnt - 1, 0).EntireRow.Copy ' копируем предыд. строку
Sheets(i).Range("A1").Offset(lRowCopy, 0).EntireRow.PasteSpecial xlPasteAll
lRowCopy = lRowCopy + 1
End If
ActiveCell.Offset(lCnt + 1, 0).EntireRow.Copy ' копируем след. строку
Sheets(i).Range("A1").Offset(lRowCopy, 0).EntireRow.PasteSpecial xlPasteAll
lRowCopy = lRowCopy + 1
End If
lCnt = lCnt + 1
Loop
End Sub