Sub the_change()
Dim i As Long
Dim lr As Long
Dim lr2 As Long
Dim cell As Range, rng As Range
Dim Blank As Worksheet
Application.ScreenUpdating = False
Set Blank = Worksheets("blank")
lr = Worksheets("blank").Cells(Rows.Count, 2).End(xlUp).Row + 2
Set rng = Blank.Range("D5:D" & lr & ",F5:F" & lr)
For Each cell In rng
    If Not IsEmpty(cell) Then
    With Worksheets("BD")
        lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lr2, 1) = Blank.Cells(1, 2)
        .Cells(lr2, 2) = Blank.Cells(2, cell.Column - 1)
        .Cells(lr2, 3) = Blank.Cells(cell.Row, cell.Column - 1)
        .Cells(lr2, 4) = Blank.Cells(cell.Row, cell.Column)
    End With
    End If
Next cell
Application.ScreenUpdating = True
End Sub