Excel Criação de rotina em VBA

[Ana Carolina Teixeira]

Olá, estou com um probema em fazer minha rotina VBA funcionar. Quero vincular minha rotina a um botão e que ao clicá-lo realize o seguinte: Insira as informações uma a uma de uma planilha em uma célula que fará os calculos  e gerará um resultado, quero pegar esse resultado  junto com a informação da outra tabela e colar em uma tabela a parte. Meu problema é que ao clicar neste botão aparentemente passa as informações pela célula mas não atualiza minha planilha, não sei o que está ocorrendo. Sei que é um pouco confuso, disponibilizo aqui a rotina. 

 

Private Sub CommandButton1_Click()

Dim linha As Integer

linha = 3
perfil = Sheets("Perfis lam. gerdau").Cells(4, 1).Value
peso = Sheets("Perfis lam. gerdau").Cells(4, 2).Value
volta:
linha = linha + 1

If Sheets("Perfis lam. gerdau").Cells(linha, 1).Value = "" Then GoTo sai

Sheets("calculo").Cells(5, 8).Value = Sheets("Perfis lam. gerdau").Cells(linha, 1).Value

    If Sheets("calculo").Cells(5, 13).Value <= 1 Then
        If Sheets("calculo").Cells(5, 13).Value < peso Then
        peso = Sheets("calculo").Cells(5, 13).Value
        perfil = Sheets("calculo").Cells(5, 8).Value
        Else
        End If
    Else
    End If
    
GoTo volta
sai:

Sheets("calculo").Cells(5, 8).Value = perfil

End Sub

Private Sub CommandButton2_Click()

Call otimizar

End Sub

Private Sub CommandButton3_Click()

End Sub
Sub otimizar()
Dim linha As Integer
Dim linha2 As Integer
linha2 = 5

Sheets("calculo").Range("R7:T1000").ClearContents
linha = 3
perfil = Sheets("Perfis lam. gerdau").Cells(4, 1).Value
peso = Sheets("Perfis lam. gerdau").Cells(4, 2).Value
volta:
linha = linha + 1

If Sheets("Perfis lam. gerdau").Cells(linha, 1).Value = "" Then GoTo sai

Sheets("calculo").Cells(5, 8).Value = Sheets("Perfis lam. gerdau").Cells(linha, 1).Value

    If Sheets("calculo").Cells(5, 11).Value <= 1 Then
    linha2 = linha2 + 1
        Sheets("calculo").Cells(5, 20).Value = "Perfil"
        Sheets("calculo").Cells(5, 21).Value = "Peso"
        Sheets("calculo").Cells(5, 22).Value = "%"
       Sheets("calculo").Cells(linha2, 20).Value = Sheets("calculo").Cells(5, 8).Value
       Sheets("calculo").Cells(linha2, 21).Value = Sheets("calculo").Cells(13, 13).Value
       Sheets("calculo").Cells(linha2, 22).Value = Sheets("calculo").Cells(5, 13).Value
        Else
    End If

    
GoTo volta
sai:

Range("R7:T8735").Select
    ActiveWorkbook.Worksheets("calculo").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("calculo").Sort.SortFields.Add Key:= _
        Range("S8:S160"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("calculo").Sort
        .SetRange Range("R7:T160")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("calculo").Cells(5, 8).Value = Sheets("calculo").Cells(6, 20).Value
End Sub
 

 

Projeto_tcc_macro_teste.xlsx

[Márcio Rodrigues]

Olá Ana Carolina Teixeira

Não consegui entender o q você precisa. O resultado está na plan calculo nas colunas T e V... qual outra informação q você que pegar e levar pra onde?

 

[Ana Carolina Teixeira]

Oi, Márcio.

Preciso pegar os perfis da coluna A da planilha "Perfis lam. gerdau" e passá-los  um a um pela célula H5, para que ela efetue os cálculos, gerando resultados  do perfil (H5), seu peso (M13) e porcentagem (M5), preciso jogar esses valores na tabela das colunas T,U e V da planilha "calculo".

Com essa rotina que eu tentei fazer ele calcula apenas quando eu executo a macro, mas não atualiza a tabela das colunas T,U e V quando clico no botão, também não atualiza se eu modificar as informações de entrada. 

[Márcio Rodrigues]

Olá Ana Carolina Teixeira

Veja se é por aí...

Projeto_tcc_macro_teste v1.rar

[Edson Luiz Branco]

Mais uma:

Private Sub CommandButton1_Click()
   Dim rgPerfLam As Range, i As Long
   With Worksheets("Perfis lam. gerdau")
     Set rgPerfLam = .Range(.[A4], .[A4].End(xlDown))
   End With
   With Worksheets("calculo")
     .Range(.[T6], .[T6].End(xlDown)).Resize(, 3).ClearContents
     Application.ScreenUpdating = False
       For i = 1 To rgPerfLam.Cells.Count
          .[H5] = rgPerfLam.Cells(i).Value
          .[T5].Offset(i, 0) = .[H5]
          .[T5].Offset(i, 1) = .[M13]
          .[T5].Offset(i, 2) = .[M5]
       Next i
     Application.ScreenUpdating = True
   End With
End Sub

 

[Ana Carolina Teixeira]

Obrigada, Marcio, é exatamente isso. Obrigada, Edson, pela ajuda.