问将数据复制到B列中的空白单元格，直到A列中的最后使用范围

EN

Sub FindString()
    Dim A As Range, r As Range, last As Range
    Set A = Intersect(ActiveSheet.UsedRange, Range("A:A"))

    For Each r In A
        If IsNumeric(Left(r, 6)) Then Set last = r
        If Not last Is Nothing Then last.Copy r.Offset(0, 1)
    Next r
End Sub

At cell B4: `=A4`
At cell B5: `=IF(ISNUMBER(VALUE(LEFT(A5, 6))),  A5, B4)`
Now copy B5, select the whole column B until last cell and paste.

Sub Demo()
    Dim r As Range

    With ActiveSheet
        Set r = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

    r.Offset(0, 1).Formula = "=IF(ISNUMBER(VALUE(LEFT(A4,6))),A4,B3)"
    r.Offset(0, 1) = r.Offset(0, 1).Value

End Sub