- 15 Ago 2019 às 11:23
#46904
Bom dia senhores
Dias atrás eu solicitei umas informações aqui e agora estou tentando alterar, mas não obtive resultado.
Vamos ao problema
Qdo uma célula é alterada (planilha Dados IT-14, célula K5) tenho 3 opções que são :
CARGA DE INCÊNDIO ESPECÍFICA POR OCUPAÇÃO
MÉTODO PARA LEVANTAMENTO DA CARGA DE INCÊNDIO ESPECÍFICA
MÉTODO DE CÁLCULO DETERMINÍSTICO PARA LEVANTAMENTO DA CARGA DE INCÊNDIO ESPECÍFICA
Cada uma dessas opções, qdo selecionadas atraves da celula K5 irá gerar um cálculo ou um resultado.
Após isso, deverá ser copiado e colado automaticamente na planilha IT-14 a partir da celula C21.
Entretanto não está colando automaticamente e para alguns argumentos dá ERRO 400.
Segue o VBA que alterei.
Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 51) <> "$K$5$" Then Exit Sub
Rows("14:66").Hidden = False
If Target.Address = "$K$5" Then Exit Sub
If Left(Target.Value, 1) = "N" Then
Rows("14:66").Hidden = True
ElseIf Left(Target.Value, 1) = "0" Then
Rows("31:66").Hidden = True
Else: Rows("14:30").Hidden = True
End If
Call Copiar
End Sub
Sub Copiar()
Dim rng As String
If Plan34.Range("K5").Value = Plan34.Range("AI5").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI6").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI7").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI8").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI9").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI10").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI11").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI12").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI13").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI14").Value Then
'Copiar 23:30
rng = "B23:X30"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI15").Value Then
'Copiar 31:66
rng = "B31:X66"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI16").Value Then
'Copiar 31:66
rng = "B31:X66"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI17").Value Then
'Copiar 31:66
rng = "B31:X66"
Else
Exit Sub
End If
'Limpar antes
Plan30.Range("B21:Y56").Value = Empty
'Copiar dados
Sheets("Dados IT-14").Range(rng).Copy
'Cola os dados no destino
Sheets("IT-14").Range("C21").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
A planilha esta anexo
Preciso de uma ajuda
Obrigado
Dias atrás eu solicitei umas informações aqui e agora estou tentando alterar, mas não obtive resultado.
Vamos ao problema
Qdo uma célula é alterada (planilha Dados IT-14, célula K5) tenho 3 opções que são :
CARGA DE INCÊNDIO ESPECÍFICA POR OCUPAÇÃO
MÉTODO PARA LEVANTAMENTO DA CARGA DE INCÊNDIO ESPECÍFICA
MÉTODO DE CÁLCULO DETERMINÍSTICO PARA LEVANTAMENTO DA CARGA DE INCÊNDIO ESPECÍFICA
Cada uma dessas opções, qdo selecionadas atraves da celula K5 irá gerar um cálculo ou um resultado.
Após isso, deverá ser copiado e colado automaticamente na planilha IT-14 a partir da celula C21.
Entretanto não está colando automaticamente e para alguns argumentos dá ERRO 400.
Segue o VBA que alterei.
Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 51) <> "$K$5$" Then Exit Sub
Rows("14:66").Hidden = False
If Target.Address = "$K$5" Then Exit Sub
If Left(Target.Value, 1) = "N" Then
Rows("14:66").Hidden = True
ElseIf Left(Target.Value, 1) = "0" Then
Rows("31:66").Hidden = True
Else: Rows("14:30").Hidden = True
End If
Call Copiar
End Sub
Sub Copiar()
Dim rng As String
If Plan34.Range("K5").Value = Plan34.Range("AI5").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI6").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI7").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI8").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI9").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI10").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI11").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI12").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI13").Value Then
'Copiar 14:22
rng = "B14:X22"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI14").Value Then
'Copiar 23:30
rng = "B23:X30"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI15").Value Then
'Copiar 31:66
rng = "B31:X66"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI16").Value Then
'Copiar 31:66
rng = "B31:X66"
ElseIf Plan34.Range("K5").Value = Plan34.Range("AI17").Value Then
'Copiar 31:66
rng = "B31:X66"
Else
Exit Sub
End If
'Limpar antes
Plan30.Range("B21:Y56").Value = Empty
'Copiar dados
Sheets("Dados IT-14").Range(rng).Copy
'Cola os dados no destino
Sheets("IT-14").Range("C21").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
A planilha esta anexo
Preciso de uma ajuda
Obrigado
Você não está autorizado a ver ou baixar esse anexo.