Notifications
Clear all

COPIAR E COLAR VALORES EM OUTRA PLANILHA

7 Posts
4 Usuários
0 Reactions
1,699 Visualizações
(@jonascruz)
Posts: 0
New Member
Topic starter
 

Pessoal, boa tarde.

Por favor, poderiam me ajudar com essa macro?
Eu recebo diariamente por email a planilha "Diaria.xlsx". De acordo com o número de serviços, ela vai copiar o mesmo número de serviços para a planilha "Controle Geral.xlsx".
A planilha Diaria pode ser do tipo complementar ou inicial. A unica diferença é que se for Complementar, vai preencher as colunas R, V e W com NA e bloquear edição dessas células.

Essas 3 linhas do inicial são geradas pelos 3 tipos de serviço do mesmo fornecedor.
Somente 1 fornecedor executará um serviço inicial. Pode acontecer de outro fornecedor execute um serviço complementar (no meu exemplo são 2 serviços complementares).

Se puderem me dar os passos que preciso executar (pseudocódigo mesmo), já ajudaria. Eu consigo pesquisar e desenvolver.

 
Postado : 14/07/2016 10:03 am
(@edilsonfl)
Posts: 227
Estimable Member
 

Olá Jonascruz,

acredito que seu tópico ainda não teve resposta dos colaboradores do Planilhando por está um pouco confuso.
1- sua planilha diária tem aparência de um formulário, e não ficou muito claro o que deve migrar para controle geral;
2- Você pergunta duas coisas na mesma mensagem, como copiar e deixa implícito "Essas 3 linhas do inicial são geradas pelos 3 tipos de serviço do mesmo fornecedor." ????.
3- que número de serviço é esse que vc cita?

Sugiro que vc use o gravador de macros do Excel:

1 - Em algum local da planilha Diária ( sugiro outra aba/planilha), "monte" linhas com tudo o que vai ser copiado para a planilha controle Geral, no mesmo formato desta, assim você poderá colocar fórmulas com os critérios necessário.

ative o gravador de macros,
copie ou recorte o intervalo desejado,
vá para a planilha controle geral,
desbloqueie,
insira uma linha abaixo da linha 3 na planilha controle geral
cole ( ou cole especial ) na linha 4,
bloquei novamente,
salve.
saia do gravador.

 
Postado : 25/07/2016 4:55 pm
(@djunqueira)
Posts: 0
New Member
 

Pois é, ESCOPO, SERVIÇO, CELULAR devem ser tratados de q forma?
Pessoal aqui não usa telepatia.

 
Postado : 26/07/2016 12:19 am
(@osvaldomp)
Posts: 857
Prominent Member
 

Olá, Jonas.

Veja se o código abaixo faz o trabalho desejado.

Sub Replicadados()
 Dim wso As Worksheet, wsd As Worksheet, x As Long
 Dim rgAs As Range, LR As Long, TI As String, k As Long, c As Variant, CL As Variant
  Set wsd = Workbooks("Controle Geral").Sheets("Controle Geral")
   For Each wso In ThisWorkbook.Sheets(Array("inicial", "complementar"))
    With wsd
     LR = .Cells(Rows.Count, 2).End(3).Row
     Set rgAs = wso.[E7:M7].Find("x", lookat:=xlWhole, after:=[E7], searchorder:=xlByRows)
     If Not rgAs Is Nothing Then TI = rgAs.Offset(, 1).Address Else TI = wso.[E7].Address
     x = Application.CountA(wso.[C24:C33])
     CL = Array("C16", TI, "C10", "M10", "C18", "C20", "C22", "K22", "K16")
     .Cells(LR + 1, 2).Resize(x).Value = Application.Proper(wso.Name)
     For Each c In CL
      .Cells(LR + 1, k + 3).Resize(x).Value = wso.Range(c).Value
      k = k + 1
     Next c
      .Cells(LR + 1, 12).Resize(x).Value = wso.[C24].Resize(x).Value
      If wso.Name = "complementar" Then
       Union(.Cells(LR + 1, 18).Resize(x), .Cells(LR + 1, 22).Resize(x), .Cells(LR + 1, 23).Resize(x)) = "NA"
      End If
    End With
    k = 0
   Next wso
End Sub

obs.
1. instale o código em um módulo comum do arquivo 'Diaria.xlsx'
2. considerei que o arquivo 'Controle Geral' também estará aberto ao rodar o código
3. se a planilha 'Controle Geral' estiver protegida, desproteja antes de rodar o código
4. não inclui no código ainda o bloqueio das células das colunas R, V e W
5. o código pode ser rodado com qualquer planilha sendo a planilha ativa, inclusive a 'Controle Geral'

 
Postado : 26/07/2016 7:28 pm
(@jonascruz)
Posts: 0
New Member
Topic starter
 

Olá, Jonas.

Veja se o código abaixo faz o trabalho desejado.

Sub Replicadados()
 Dim wso As Worksheet, wsd As Worksheet, x As Long
 Dim rgAs As Range, LR As Long, TI As String, k As Long, c As Variant, CL As Variant
  Set wsd = Workbooks("Controle Geral").Sheets("Controle Geral")
   For Each wso In ThisWorkbook.Sheets(Array("inicial", "complementar"))
    With wsd
     LR = .Cells(Rows.Count, 2).End(3).Row
     Set rgAs = wso.[E7:M7].Find("x", lookat:=xlWhole, after:=[E7], searchorder:=xlByRows)
     If Not rgAs Is Nothing Then TI = rgAs.Offset(, 1).Address Else TI = wso.[E7].Address
     x = Application.CountA(wso.[C24:C33])
     CL = Array("C16", TI, "C10", "M10", "C18", "C20", "C22", "K22", "K16")
     .Cells(LR + 1, 2).Resize(x).Value = Application.Proper(wso.Name)
     For Each c In CL
      .Cells(LR + 1, k + 3).Resize(x).Value = wso.Range(c).Value
      k = k + 1
     Next c
      .Cells(LR + 1, 12).Resize(x).Value = wso.[C24].Resize(x).Value
      If wso.Name = "complementar" Then
       Union(.Cells(LR + 1, 18).Resize(x), .Cells(LR + 1, 22).Resize(x), .Cells(LR + 1, 23).Resize(x)) = "NA"
      End If
    End With
    k = 0
   Next wso
End Sub

obs.
1. instale o código em um módulo comum do arquivo 'Diaria.xlsx'
2. considerei que o arquivo 'Controle Geral' também estará aberto ao rodar o código
3. se a planilha 'Controle Geral' estiver protegida, desproteja antes de rodar o código
4. não inclui no código ainda o bloqueio das células das colunas R, V e W
5. o código pode ser rodado com qualquer planilha sendo a planilha ativa, inclusive a 'Controle Geral'

Funcionou perfeitamente, fez tudo que preciso.
Seria possível comentar as variáveis? Vou precisar continuar as tarefas e se eu não entender o que cada parte faz, não consigo evoluir.

Muito obrigado mesmo.

 
Postado : 29/07/2016 11:25 am
(@osvaldomp)
Posts: 857
Prominent Member
 

Olá, Jonas.
Abaixo o código comentado.
Cada comentário se refere à linha do código imediatamente acima dele.
Sugestão - cole o código em um módulo, a fonte dos comentários ficará na cor verde o que facilita a leitura. Retorne se restaram dúvidas.

Sub Replicadados()
    Dim wso As Worksheet, wsd As Worksheet, x As Long
    Dim rgAs As Range, LR As Long, TI As String, k As Long, c As Variant, CL As Variant
      Set wsd = Workbooks("Controle Geral").Sheets("Controle Geral")
        'wsd >> planilha "Controle Geral" do arquivo "Controle Geral"
       For Each wso In ThisWorkbook.Sheets(Array("inicial", "complementar"))
        'wso >> na primeira passada do Loop será a planilha "inicial" e na segunda, "complementar"
        With wsd
         LR = .Cells(Rows.Count, 2).End(3).Row
         'LR >> última linha com conteúdo na coluna 'B' da planilha wsd
         Set rgAs = wso.[E7:M7].Find("x", lookat:=xlWhole, after:=[E7], searchorder:=xlByRows)
         'rgAs >> célula com conteúdo igual a "x" no intervalo referido da planilha wso
         If Not rgAs Is Nothing Then TI = rgAs.Offset(, 1).Address Else TI = wso.[E7].Address
         'TI >> endereço da célula á direita da célula que contiver o "x", caso exista no intervalo, ou
         'TI >> endereço de 'E7', célula vazia, arbitrário, para não deixar TI sem valor
         x = Application.CountA(wso.[C24:C33])
         'x >> conta o número de serviços listados no intervalo
         CL = Array("C16", TI, "C10", "M10", "C18", "C20", "C22", "K22", "K16")
         'CL >> matriz contendo as células a serem copiadas
         .Cells(LR + 1, 2).Resize(x).Value = Application.Proper(wso.Name)
         'cola o nome da planilha wso
         For Each c In CL
          'c >> cada célula da matrix CL
          .Cells(LR + 1, k + 3).Resize(x).Value = wso.Range(c).Value
          'cola cada c na planilha wsd
          k = k + 1
          'k >> contador de colunas
         Next c
          .Cells(LR + 1, 12).Resize(x).Value = wso.[C24].Resize(x).Value
          'cola a lista de serviços
          If wso.Name = "complementar" Then
           Union(.Cells(LR + 1, 18).Resize(x), .Cells(LR + 1, 22).Resize(x), .Cells(LR + 1, 23).Resize(x)) = "NA"
          'se wso for a planilha "complementar" insere "NA" nas células
          End If
        End With
        k = 0
       Next wso
    End Sub
 
Postado : 29/07/2016 4:00 pm
(@jonascruz)
Posts: 0
New Member
Topic starter
 

Muito obrigado pela ajuda.

Vou colocar o tópico como resolvido :)

 
Postado : 01/08/2016 1:07 pm