太字のテキスト見出しを検索し、別の列に値を入れて

Question

私は列Aをループし、太字の見出しを見つけて、その値を取り、各行に列Fを入れる方法を理解しようとしています。

サンプルデータ：http://s000.tinyupload.com/?file_id=58119513586509989991

あなたは、サンプルデータで私が働いている実際のデータと私が達成しようとしている結果を見ることができます。どんな助けでも大歓迎です。

これまで私がこれまで行ってきたことです。私は単に '見出し' の値を取り、列Fに貼り付け、行番号には 'ActiveCell.Row'

Sub Test2() 
    Range("A1").Select 
    Do Until IsEmpty(ActiveCell) 
    If ActiveCell.Font.Bold = True Then 
     Heading = ActiveCell.Value 
    Else 

    End If 
    Debug.Print Heading 
    Debug.Print ActiveCell.Row 


    ActiveCell.Offset(1, 0).Select 
    Loop 
End Sub 

おかげで、A.S.H @

sniper26

Answer 1

Sub AddHeadings() 
    Dim heading As Range 
    For Each cel In Range("A3:A20") '<~~ set it to the appropriate range 
     If Trim(cel.Text) <> "" Then 
      If cel.Font.Bold Then 
       Set heading = cel 
      Else 
       If Not heading Is Nothing Then heading.Copy cel.Offset(, 5) 
      End If 
     End If 
    Next 
End Sub