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
Alguma ideia?
Disponibilize os arquivos
Marcelo Prudencio
"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.
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.
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!
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