Este fórum está sendo desativado

[philippemilioni]

Bom dia

Estou tentando copiar algumas linhas e colunas de uma planilha para outra, sendo que essas linhas e colunas são alteradas em função da seleção feita em uma caixa suspensa.
Tentei dessa maneira, mas não obtive exito

Sub copiarDadosEntrePlanilhas()

'Copiar dados
Sheets("Cadastro IT 07").Range("B55:X76").Copy
'Ativa a planilha de destino
Sheets("IT-07").Activate
'Seleciona o intervalo de destino
Range("C67").Select
'Cola os dados no destino
ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

Alguém pode me dar uma idéia?
Grato

[eduardogrigull]

Olá,
Voce nao precisa ativar a planilha durante a cópia. Só precisa especificar qual planilha colar

Código: Selecionar todos

'Copiar dados
Sheets("Cadastro IT 07").Range("B55:X76").Copy

'Cola os dados no destino
Sheets("IT-07").Range("C67").PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

[philippemilioni]

Consegui copiar de uma planilha para outra.
Entretanto ainda não está da maneira que deveria.
Quando seleciono uma opção na caixa de seleção, não altera as linhas que devem ser copiadas
Por exemplo
opção 1 - sem linhas para cópia
opção 2 - copiar linhas 55 a 68 (Colunas B até X)
Opção 3 - copiar linhas 69 a 76 (Colunas B ate X)
tem como resolover?

[eduardogrigull]

Voce usa um ComboBox pra filtrar entre essas três opções? A primeira opção é não copiar nada então?

[philippemilioni]

Uso uma caixa de seleção com essas tres opções:
Opção 1: Não foram considerados fatores redutores de distância. (sem linhas para cópia)
Opção 2: Os fatores especificados na Tabela B-1, considerando as fachadas que recebem exposição de calor proveniente de edificações adjacentes localizadas dentro do mesmo lote. copiar linhas 55 a 68 (Colunas B até X)
Opção 3: Sendo a edificação com até 12 m de altura e 750 m² de área, foram utilizados os fatores especificados na Tabela 3.
copiar linhas 69 a 76 (Colunas B ate X)

[eduardogrigull]

Assim funciona? Botei a ação num CommandButton, e um script de cópia. De acordo com a opção selecionada no campo de listagem ele copia... Voce precisa alterar o nome do botão e do listbox

Código: Selecionar todos

Dim rgn As String
Private Sub CommandButton1_Click()

If ListBox1.ListIndex = 0 Then
    'Nao fazer nada
ElseIf ListBox1.ListIndex = 1 Then
    'Copiar 55-68
    rng = "B55:X68"
    Call Copiar
Else
    'Copiar 69-76
    rng = "B69:X76"
    Call Copiar
End If
End Sub

Sub Copiar()

'Copiar dados
Sheets("Cadastro IT 07").Range(rng).Copy

'Cola os dados no destino
Sheets("IT-07").Range("C67").PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

[philippemilioni]

Vou testar, mas gostaria que fosse feita de forma automática, sem a necessidade de uma ação (botão)

[eduardogrigull]

Daí vou precisar que voce anexe o arquivo. Ai fica bem mais fácil e rapido

[philippemilioni]

Aí esta a planilha que estou trabalhando.

[eduardogrigull]

Consegui.
Voce precisa adicionar nas propriedades da Planilha 25 (Cadastro IT 07), na opcao WorksheetChanges: "Call Copiar"


E logo abaixo inserir:

Código: Selecionar todos

Sub Copiar()
Dim rng As String


If Plan25.Range("B52").Value = Plan25.Range("BD29").Value Then
    'Nao fazer nada
    Exit Sub
ElseIf Plan25.Range("B52").Value = Plan25.Range("BD30").Value Then
    'Copiar 55-68
    rng = "B55:X68"
ElseIf Plan25.Range("B52").Value = Plan25.Range("BD31").Value Then
    'Copiar 69-76
    rng = "B69:X76"
Else
    Exit Sub
End If


'Copiar dados
Sheets("Cadastro IT 07").Range(rng).Copy

'Cola os dados no destino
Sheets("IT-07").Range("C67").PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

Ou ver o anexo talvez seja mais facil

[philippemilioni]

Opa!!! Valeu Eduardo
Agora está funcionando.
Mas tenho uma dúvida ainda.
Qdo faço a escolha na caixa de seleção, por exemplo a opção 2 e depois se eu alterar para a opção 1 ou 3, na Planilha que vai ser colado Plan23 (IT 07) ainda fica o que foi colado na opção anterior.
Mas agradeço muito pela ajuda, não manjo nada de VBA

[eduardogrigull]

Tinha me esquecido disso. Corrigido... se quiser é só substituir o codigo do Sub Copiar, ou baixar o anexo de novo

Código: Selecionar todos

Sub Copiar()
Dim rng As String


If Plan25.Range("B52").Value = Plan25.Range("BD29").Value Then
    'Nao fazer nada, somente limpar antes
    Plan23.Range("B67:Y79").Value = Empty
    Exit Sub
ElseIf Plan25.Range("B52").Value = Plan25.Range("BD30").Value Then
    'Copiar 55-68
    rng = "B55:X68"
ElseIf Plan25.Range("B52").Value = Plan25.Range("BD31").Value Then
    'Copiar 69-76
    rng = "B69:X76"
Else
    Exit Sub
End If

'Limpar antes
Plan23.Range("B67:Y79").Value = Empty


'Copiar dados
Sheets("Cadastro IT 07").Range(rng).Copy

'Cola os dados no destino
Sheets("IT-07").Range("C67").PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

[philippemilioni]

Bom dia.
Eduardo, agora ficou excelente.
Vou tentar entender os códigos para aprender.
Agradeço imensamente,
abs