Have Excel Auto Populate Column Headings in Blank Rows (VBA?) - vba

Question

I have a spreadsheet that looks something like this:
A B C D E F
1 Program Year Cycle Date Panel Mtg Rep
2 AAA 2019 1 5/21 ABA Tom
3 AAA 2019 1 5/23 ABB Erin
4
5 BBB 2019 2 6/4 BAB Jim
6
7 CCC 2019 3 7/16 CAB Tom
8 CCC 2019 4 8/27 CBB Kate
9
10
What I'm trying to have it do is, every time a row is skipped, that blank row will automatically be populated with the column headings. So in the example table above, rows 4 and 6 would contain the column headings, while row 9 would remain blank until information was entered on row 10. I've done every possible search I can think of, and haven't found anything that seems applicable. I'm not very familiar with VBA, so I came up with the following series of formulas:
A3) =IF(AND($A2<>"",$A4<>"",$A2<>$A$1),$A$1,"")
B3) =IF(A3=A$1,B$1,"")
C3) =IF(B3=B$1,C$1,"")
D3) =IF(C3=C$1,D$1,"")
E3) =IF(D3=D$1,E$1,"")
F3) =IF(E3=E$1,F$1,"")
These formulas are then extended to the rest of the sheet. This does what I want it to do, but it also fills 8,000+ cells with formulas, including circular references. Which, aside from having to deal with being alerted to the circular references, they also affect other aspects of my sheet, such as conditional formatting, identifying duplicate entries, etc.
As I stated, I'm not really very familiar with VBA, so I don't even know if this is doable using VBA. But if there is some way to achieve the same result without formulas, or at least without circular references, that is what I'm looking for. Thanks so much for any assistance.

Answer 1

This code should work:
see before:
and after:
Sub addHeaders()
Dim ws As Worksheet
Set ws = Sheets("Sheet3")
Dim lastRow As Integer
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim header As Range
Set header = ws.Range("A1:F1")
For rowNum = 2 To lastRow
If ws.Cells(rowNum, 1) = "" Then
If ws.Cells(rowNum + 1, 1) <> "" Then
ws.Range("A" & rowNum & ":F" & rowNum) = header.Value
End If
End If
Next rowNum
End Sub
Since you said you are new to vba here is quick quick intro to how to run a program:

Answer 2

Something like this is what you're looking for:
Sub tgr()
Dim ws As Worksheet
Dim rHeaders As Range
Dim rDest As Range
Dim ACell As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rHeaders = ws.Range("A1:F1")
For Each ACell In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).Cells
If Len(Trim(ACell.Value)) = 0 Then
If Not rDest Is Nothing Then
Set rDest = Union(rDest, ACell)
Else
Set rDest = ACell
End If
End If
Next ACell
If Not rDest Is Nothing Then rHeaders.Copy rDest
End Sub