Notifications
Clear all

Replicar Planilha em Outro Arquivo

11 Posts
2 Usuários
0 Reactions
2,233 Visualizações
(@paulocezar)
Posts: 70
Estimable Member
Topic starter
 

Galera,
Tô precisando de uma planilha que facilitaria em muito meu trabalho. É o seguinte, tenho uma planilha principal onde cadastro todos os transformadores queimados e permutados. Nessa planilha eu filtro por semana os transformadores queimados e copio pra outra planilha que envio semanalmente pra capital Teresina que é a sede da ELETROBRAS no Piaui.
O que eu precisaria da ajuda de vocês??? Que se possível vocês me ajudasse que, ao ser digitado os dados na aba “Planilha” do arquivo TRAFOS SUBSTITUIDOS – 2018, os conteúdos das colunas: K, H, M, W, X, Y, O, P, J, S, A, AI, AJ, AS, AQ, AT e AB, fossem inseridos automaticamente no arquivo TRAFOS SEMANAL, aba TRAFOS QUEIMADOS, a partir da coluna D, linha 9. Com um detalhe, que não tivessem vínculo entre os arquivos, haja vista, a necessidade desse arquivo TRAFO SEMANAL ser aberto pelos servidores de Teresina. Consultei a net e tentei adaptar todas as macros que encontrei e não deu certo (por falta de conhecimento, com certeza).
Obs.: As referidas planilhas estão em anexo.

De já meus agradecimentos a todos desse fórum que já me ajudaram tanto.

Atenciosamente,

Paulo Cézar.

 
Postado : 25/01/2018 9:00 am
(@klarc28)
Posts: 971
Prominent Member
 

Consultei a net e tentei adaptar todas as macros que encontrei e não deu certo (por falta de conhecimento, com certeza).

Prefiro que a pessoa poste o código que tentou e diga o que não funcionou ou o que não conseguiu fazer.

 
Postado : 25/01/2018 9:20 am
(@klarc28)
Posts: 971
Prominent Member
 

Arquivos de exemplo, caso deseje fazer adaptações.

 
Postado : 25/01/2018 9:34 am
(@klarc28)
Posts: 971
Prominent Member
 
Option Explicit

Private Sub Workbook_Open()
'Abre a pasta receptora que está salva no mesmo local em que esta pasta está salva
'Já foi testado e funcionou
Workbooks.Open (ThisWorkbook.Path & "Pasta Receptora.xlsm")

Dim wkb As Workbook
'wkb passa a ser a pasta receptora
Set wkb = ActiveWorkbook
'ultima linha do intervalo doador
Dim ulinha As Long

ulinha = ThisWorkbook.Sheets("Plan1").UsedRange.Rows.Count
'ativando a pasta doadora
ThisWorkbook.Activate

'selecionando a planilha doadora
ThisWorkbook.Sheets("Plan1").Select

'selecionando o intervalo doador
ThisWorkbook.Sheets("Plan1").Range("H2:H" & ulinha & ",K2:K" & ulinha & ",M2:M" & ulinha & ",W2:W" & ulinha & ",X2:X" & ulinha & ",Y2:Y" & ulinha & ",O2:O" & ulinha & ",P2:P" & ulinha & ",J2:J" & ulinha & ",S2:S" & ulinha & ",A2:A" & ulinha & ",AI2:AI" & ulinha & ",AJ2:AJ" & ulinha).Select


'copiando o intervalo doador
Selection.Copy

'ativando pasta receptora
wkb.Activate

'selecionando a planilha receptora
wkb.Sheets("Plan1").Select

'selecionado célula receptora
wkb.Sheets("Plan1").Range("E9").Select

'colando
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'tirando a seleção
Application.CutCopyMode = False

'salvando a pasta receptora
wkb.Save
'fechando a pasta receptora
wkb.Close



End Sub
 
Postado : 25/01/2018 10:06 am
(@paulocezar)
Posts: 70
Estimable Member
Topic starter
 

Klarc,
Só não deu 100% certo ainda porque as células a serem copiadas não é num intervalo de células, mas em colunas intercaladas:
Ex: K, H, M, W, X, Y .......
Está dando erro justamente nessa linha: ThisWorkbook.Sheets("Plan1").Range("A2:E" & ulinha).Select (Números de argumentos incorreto ou atribuição

 
Postado : 25/01/2018 3:09 pm
(@klarc28)
Posts: 971
Prominent Member
 
    ThisWorkbook.Sheets("Plan1").Range("H2:H" & ulinha & ",K2:K" & ulinha & ",M2:M" & ulinha & ",W2:W" & ulinha & ",X2:X" & ulinha & ",Y2:Y" & ulinha & ",O2:O" & ulinha & ",P2:P" & ulinha & ",J2:J" & ulinha & ",S2:S" & ulinha & ",A2:A" & ulinha & ",AI2:AI" & ulinha & ",AJ2:AJ" & ulinha).Select

 
Postado : 25/01/2018 3:37 pm
(@paulocezar)
Posts: 70
Estimable Member
Topic starter
 

Klarc,
Fiz as alterações acima sugeridas e tá dando o seguinte erro: "ESSA AÇÃO NÃO FUNCIONARÁ EM VÁRIAS SELEÇÕES". E o erro está dando na seguinte linha: "Selection.Copy"

 
Postado : 25/01/2018 4:36 pm
(@klarc28)
Posts: 971
Prominent Member
 

Aqui não deu erro, mas em vez de fazer várias colunas ao mesmo tempo, você pode copiar uma coluna, colar, copiar outra coluna, colar...

Private Sub Workbook_Open()
'Abre a pasta receptora que está salva no mesmo local em que esta pasta está salva
'Já foi testado e funcionou
Workbooks.Open (ThisWorkbook.Path & "Pasta Receptora.xlsm")

Dim wkb As Workbook
'wkb passa a ser a pasta receptora
Set wkb = ActiveWorkbook
'ultima linha do intervalo doador
Dim ulinha As Long

ulinha = ThisWorkbook.Sheets("Plan1").UsedRange.Rows.Count

'++++++++++++++++ATENÇÃO+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'ativando a pasta doadora
ThisWorkbook.Activate

'selecionando a planilha doadora
ThisWorkbook.Sheets("Plan1").Select

'selecionando o intervalo doador
'ThisWorkbook.Sheets("Plan1").Range("H2:H" & ulinha & ",K2:K" & ulinha & ",M2:M" & ulinha & ",W2:W" & ulinha & ",X2:X" & ulinha & ",Y2:Y" & ulinha & ",O2:O" & ulinha & ",P2:P" & ulinha & ",J2:J" & ulinha & ",S2:S" & ulinha & ",A2:A" & ulinha & ",AI2:AI" & ulinha & ",AJ2:AJ" & ulinha).Select
ThisWorkbook.Sheets("Plan1").Range("H2:H" & ulinha).Select
'copiando o intervalo doador
Selection.Copy

'ativando pasta receptora
wkb.Activate

'selecionando planilha receptora
wkb.Sheets("Plan1").Select

'selecionando a célula receptora
wkb.Sheets("Plan1").Range("E9").Select

'colando
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'++++++++++++++++ATENÇÃO+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'ativando a pasta doadora
ThisWorkbook.Activate

'selecionando a planilha doadora
ThisWorkbook.Sheets("Plan1").Select

'selecionando o intervalo doador
'ThisWorkbook.Sheets("Plan1").Range("H2:H" & ulinha & ",K2:K" & ulinha & ",M2:M" & ulinha & ",W2:W" & ulinha & ",X2:X" & ulinha & ",Y2:Y" & ulinha & ",O2:O" & ulinha & ",P2:P" & ulinha & ",J2:J" & ulinha & ",S2:S" & ulinha & ",A2:A" & ulinha & ",AI2:AI" & ulinha & ",AJ2:AJ" & ulinha).Select
ThisWorkbook.Sheets("Plan1").Range("K2:K" & ulinha).Select
'copiando o intervalo doador
Selection.Copy

'ativando pasta receptora
wkb.Activate

'selecionando planilha receptora
wkb.Sheets("Plan1").Select

'selecionando a célula receptora
wkb.Sheets("Plan1").Range("F9").Select

'colando
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'++++++++++++++++ATENÇÃO+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'REPITA PARA AS

'OUTRAS

'COLUNAS

'ISSO É UMA GAMBIARRA POR

'ESTAR DANDO ERRO AÍ



'++++++++++++++++++++++++++++++++++++++++ FINAL+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'tirando a seleção
Application.CutCopyMode = False

'salvando a pasta receptora
wkb.Save
'fechando a pasta receptora
wkb.Close



End Sub

 
Postado : 25/01/2018 4:57 pm
(@paulocezar)
Posts: 70
Estimable Member
Topic starter
 

Klarc,
Não ficou muito bem, demora demais transferir coluna por coluna e ficou uma loucura. Você falou em gambiarra, resolvi fazer a minha. Criei uma aba denominada "replicada" e como diz o titulo, repliquei a planilha principal e usei sua formula, só não deu certo porque está copiando as formulas e colando números, mas se tivesse como copiar e colar os valores da aba replicada e colar na aba de destino, ficaria beleza.

 
Postado : 26/01/2018 8:40 am
(@klarc28)
Posts: 971
Prominent Member
 

Para deixar mais rápido faça isto:


sub copiar( )
Application.ScreenUpdating = False


'código para copiar e colar aqui



Application.ScreenUpdating = True
end sub

O código a seguir é para colar somente valores:

'colando
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Para colar as fórmulas:

Option Explicit

Sub copiar()
Plan1.Select

Plan1.Range("A1").Select

Selection.Copy

Plan2.Select

Plan2.Range("A1").Select

'colando
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False

ActiveSheet.Paste

ThisWorkbook.Save
End Sub
 
Postado : 26/01/2018 9:37 am
(@paulocezar)
Posts: 70
Estimable Member
Topic starter
 

Klarc,
Depois de criar a aba "replicada"(com as colunas seguidas), copiei a formula da Planilha "Pasta Doadora" anexada por você no inicio do post e deu certo.

Muito obrigado.

 
Postado : 26/01/2018 12:25 pm