Boa tarde,
Veja se este código atende:
Sub CopiarNegrito()
Dim i As Integer
Dim Texto As String
For i = 1 To [A1].CurrentRegion.Rows.Count
If Cells(i, 1).Font.Bold Then
Texto = Cells(i, 1).Value
Else
Cells(i, 5).Font.Bold = True
Cells(i, 5).Value = Texto
End If
Next
End Sub
Abraço
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 16/12/2015 10:58 am