将标题复制到一些空白的行

Question

我有工作代码可以从工作表中删除空白行和不必要的项目。

我有一种情况需要将标题（黄色）复制到 A 列。
就像在示例中一样：将单元格 B1 复制到 A3、A4、A5 并将单元格 B6 复制到 A7、A8 等等。
如果空白，我没有任何成功。我应该申请什么条件才能做到这一点？

Sub Delete_Blank_Rows()
    Dim lRow As Long
    Dim iCntr As Long
    Dim wks As Worksheet
    Dim LngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
        lngColCounter As Long
    Dim blnAllBlank As Boolean
    Dim UserInputSheet As String
    Set wks = Sheets("FNDWRR")
    With wks
        'Now that our sheet is defined, we'll find the last row and last column
        LngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column
        'Since we need to delete rows, we start from the bottom and move up
        For lngIdx = LngLastRow To 1 Step -1
            'Start by setting a flag to immediately stop checking
            'if a cell is NOT blank and initializing the column counter
            blnAllBlank = True
            lngColCounter = 2
            'Check cells from left to right while the flag is True
            'and the we are within the farthest-right column
            While blnAllBlank And lngColCounter <= lngLastCol
                'If the cell is NOT blank, trip the flag and exit the loop
                If .Cells(lngIdx, lngColCounter) <> "" Then
                    blnAllBlank = False
                Else
                    lngColCounter = lngColCounter + 1
                End If
            Wend
            'Delete the row if the blnBlank variable is True
            If blnAllBlank Then
                .Rows(lngIdx).Delete
            End If
        Next lngIdx
    End With
    lRow = 45000
    For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 7).Value = "Functional Currency" Then
            Rows(iCntr).Delete
        End If
    Next
    Range("b1").EntireColumn.Insert  
End Sub

Answer 1

试试这个：

Sub copyHeaders()
    Dim lastRow As Integer
    Dim holdName As String

    lastRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    For r = 1 To lastRow
        If Cells(r, 1) = "Hold Name" Then
            holdName = Cells(r, 2).Value
            GoTo NextRow
        End If
        If IsEmpty(Cells(r, 1)) And Not IsNull(holdName) Then Cells(r, 1).Value = holdName
NextRow:
    Next r

End Sub