Notifications
Clear all

Copiar dados para uma planilha fechada

6 Posts
3 Usuários
0 Reactions
2,854 Visualizações
(@guism)
Posts: 14
Active Member
Topic starter
 

Boa tarde,

Tenho uma planilha (tipo um formulário, com o nome de PLANILHA ) onde insiro os dados, gostaria de criar um botão para acrescentar esse intervalo de dados (J1:R1) em outra planilha (PLANILHA 2), que está fechada, acrescentando uma linha.

Consigo abrir a planilha fechada perfeitamente, contudo acredito que não estou ativando corretamente a planilha para colar os dados.

Se executo o código sem chamar a outra planilha, com ela já aberta, ele funciona perfeitamente. Contudo, se ela está fechada aparece "Erro em tempo de execução '9': Subscrito fora do intervalo".

Dim WApp As Object
    Set WApp = CreateObject("Excel.Application")
    WApp.Workbooks.Open ("C:UsersGuismDesktopPLANILHA2.xlsm") 'endereço
    WApp.Visible = True
    WApp.WindowState = xlNormal


    Range("J1:R1").Select
    Selection.Copy
    ActiveSheet.Paste

    Windows("PLANILHA2.xlsm").Activate
    Application.Goto Reference:="R1048576C1"
    Selection.End(xlUp).Select
    ActiveCell.Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
    ActiveCell.Offset(1, 0).Range("Tabela1[[#Headers],[Nº Conta ]]").Select
    Windows("PLANILHA1.xlsm").Activate
    Selection.Copy
    Windows("PLANILHA2.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, 3).Range("Tabela1[[#Headers],[Nº Conta ]]").Select
    Application.CutCopyMode = False
    ActiveCell.Offset(2, 0).Range("Tabela1[[#Headers],[Nº Conta ]]").Select
    ActiveCell.Offset(-3, 0).Range("Tabela1[[#Headers],[Nº Conta ]]").Select
    ActiveCell.Offset(2, 0).Range("Tabela1[[#Headers],[Nº Conta ]]").Select
 
Postado : 21/09/2016 3:43 pm
(@guism)
Posts: 14
Active Member
Topic starter
 

Alguma ideia?

 
Postado : 26/09/2016 4:11 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Disponibilize os arquivos

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 26/09/2016 5:56 pm
(@guism)
Posts: 14
Active Member
Topic starter
 

Eu não posso disponibilizar a planilha, mas vou tentar explicar melhor.

Preciso criar um botão, que copie o conteúdo de um intervalo de célula de uma planilha e acrescente em outra que está fechada.

Tipo um formulário mandando informação para uma base.

 
Postado : 27/09/2016 8:36 am
Basole
(@basole)
Posts: 487
Reputable Member
 

Segue exemplo.
Ajuste as suas informações (Nome da Aba, intervalos, etc..) nos locais indicados, se necessário.

Sub Copiar_dados_para_uma_planilha_fechada()
    Dim fileName As String, excelObj As Object, winCount As Integer, rng As Range

    ' ajusta o diretorio e arquivo a variavel:
    fileName = "C:UsersGuismDesktopPLANILHA2.xlsm"
    ' verifica se existe o diretorio e arquivo:
    If Len(Dir(fileName)) = 0 Then
        MsgBox (fileName & " não existe! Veririque!"), 64, "Verificando Arquivo"
        Exit Sub
    End If

    ' cria o objeto
    Set excelObj = GetObject(fileName)
    ' ajusta o intervalo de EstaPasta_de_trabalho da Planilha(aba) ativa:
    Set rng = ThisWorkbook.ActiveSheet.Range("J1:R1")
    'torna PLANILHA2 visivel
    winCount = excelObj.Parent.Windows.Count()
    excelObj.Parent.Windows(winCount).Visible = True
    ' envia os dados do intervalo "J1:R1" para a PLANILHA2 (plan1.A1:I1):  * altere se necessario
    excelObj.Sheets("Plan1").Range("A1:I1").Value = rng.Value
    'torna EstaPasta_de_trabalho visivel
    excelObj.Application.Visible = True
    ' Salva e fecha e PLANILHA2:
    excelObj.Close savechanges:=True

End Sub

Click em se a resposta foi util!

 
Postado : 27/09/2016 10:26 am
(@guism)
Posts: 14
Active Member
Topic starter
 

Perfeito!

Só acrescentei um código pra acrescentar uma linha na planilha e copiar o conteúdo nessa linha, para não haver sobreposição de informações.

O código completo ficou assim:

  Dim fileName As String, excelObj As Object, winCount As Integer, rng As Range

    ' ajusta o diretorio e arquivo a variavel:
    fileName = "C:UsersGuismDesktopPLANILHA2.xlsm"
    ' verifica se existe o diretorio e arquivo:
    If Len(Dir(fileName)) = 0 Then
        MsgBox (fileName & " não existe! Veririque!"), 64, "Verificando Arquivo"
        Exit Sub
    End If

    ' cria o objeto
    Set excelObj = GetObject(fileName)

    ' ajusta o intervalo de EstaPasta_de_trabalho da Planilha(aba) ativa:
    Set rng = ThisWorkbook.ActiveSheet.Range("J1:R1")

    'torna PLANILHA2 visivel
    winCount = excelObj.Parent.Windows.Count()
    excelObj.Parent.Windows(winCount).Visible = True

    'Seleciona a ultima linha da tabela e acrescenta uma linha
    excelObj.Sheets("PLANILHA2").Application.Goto Reference:="R1048576C1"
    Selection.End(xlUp).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
    ActiveCell.Offset(1, 0).Range("Tabela1[[#Headers],[Campo1]]").Select

    ' envia os dados do intervalo "J1:R1" para a PLANILHA2
    Selection.Range("A1:I1").Value = rng.Value

    'torna EstaPasta_de_trabalho visivel
    excelObj.Application.Visible = True

    ' Salva e fecha e PLANILHA2:
    excelObj.Close savechanges:=True

 
Postado : 28/09/2016 11:54 am