Boa tarde!!

Olá seja bem vindo, tata!!! (seu arquivo vai ser excluído!!)

Por favor Leia os links abaixo, obrigado!!!

Nossas Regras
viewtopic.php?f=7&t=203

Marcar Tópico como Resolvido e Agradecimento
viewtopic.php?f=7&t=3784
Lembre se de usar nossa base de dados (Pesquisa)
Att

Gostaria de saber o motivo da exclusão do arquivo. É porque não estava compactado?

seque arquivo compactado, estou precisando muito da ajuda de vocês.

Veja se é o que espera

Sub SalvaVlr()
Dim Tc As Long, Dia As Long
Dia = Range("B5")
Tc = Application.WorksheetFunction.Match(Dia, Range("d7:ag7"), 0)
Cells(8, Tc + 3) = Range("B8").Value
Cells(9, Tc + 3) = Range("B9").Value
End Sub

Ficou perfeito, muito obrigado me ajudaram muito.

Pessoal para aprimorar minha planilha ainda nesse exemplo, gostaria que essa macro executasse quando a célula b5 fosse alterada.

Pessoal mais uma força minha macro está com 149 linhas com isso está muito lenta teria com torna-la mais rápida.

Não há uma relação direta entre qtde de linhas de codigo vs velocidade; vc precisará fornecer maiores detalhes

Reinaldo, o problema é que minha macro possui 149 linhas como descrito a baixo,com isso ela fica muito lenta. Teria também como a macro executasse quando a célula b5 fosse alterada?

Sub SalvaVlr()
Dim Tc As Long, Dia As Long
Dia = Range("B5")
Tc = Application.WorksheetFunction.Match(Dia, Range("d7:ag7"), 0)
Cells(8, Tc + 3) = Range("B8").Value
Cells(9, Tc + 3) = Range("B9").Value
.
.
.
Cells(149, Tc + 3) = Range("B149").Value
End Sub

Pessoal, tentei fazer dessa forma a baixo mais fica repetindo a célula "b8". Como faço para retornar o intervalo "b8:b149"?

Sub SalvaVlr()
Dim Tc As Long, Dia As Long
Dia = Range("B5")
Tc = Application.WorksheetFunction.Match(Dia, Range("d5:ag5"), 0)
For i = 8 To 149
Cells(i, Tc + 3) = Range("b8:b149").Value
Next
End Sub

for i =8 to 149
cells(i,TC+3)=range("B"&i)
next

valeu ficou top, só falta ela executar quando a célula "b5" for alterada.

Boa noite!!

Seria..
Não testado..

Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Tc As Long, Dia As Long, i As Long 
     
    If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub 
     
    Application.EnableEvents = False 
    Dia = Range("B5").Value 
     
    Tc = -1 
    On Error Resume Next 
    Tc = Application.WorksheetFunction.Match(Dia, Range("d5:ag5"), 0) 
    On Error Goto 0 
     
    If Tc <> -1 Then 
        For i = 8 To 149 
            Cells(i, Tc + 3) = Range("B" & i) 
        Next 
    End If 
    Application.EnableEvents = True 
End Sub