Olá, @JAlmeida

Uma solução poderia ser:

Sub AtualizaComCritério()
  Dim célCritério As Range
  For Each célCritério In [B3:Q3].Cells
    If célCritério.Value = "Vencendo" Then
      With Intersect(célCritério.EntireColumn, [B7:Q18])
        .Value = .Offset(, -1).Value
      End With
    End If
  Next célCritério
End Sub

@edsonbr
Muito obrigado pela valiosa colaboração e ajuda na solução desta questão. A solução sugeria por você deu super certo, resolvendo o problema.
Meus sinceros agradecimentos.
Abcs,