Notifications
Clear all

Copiar e colar Vba

9 Posts
4 Usuários
0 Reactions
1,534 Visualizações
(@lbranco)
Posts: 5
Active Member
Topic starter
 

Boas pessoal, estou a tentar que copie uma parte de uma linha especifica ("Sheets("Registos").Range(Cells(inic, 1), Cells(inic, 17))") e cole noutra planilha ("Sheets("LISTAS").Range("A" & FinalLinhaList + 1)") mas dá erro, alguém sabe porque?
e já agora cada vez que executo a macro quero que apague os dados da planilha "LISTAS" e utilizo o "Sheets("LISTAS").Select" e "Selection.ClearContents" e tambem não funciona. Podem ajudar-me???

Sub organizar()
      Prod(1) = Sheets("Preçario").Range("B3")
      FinalLinhaReg = Sheets("Registos").Range("B" & Rows.Count).End(xlUp).Row 'calcular ultimo registo

Sheets("LISTAS").Select
Selection.ClearContents

For inic = 149 To FinalLinhaReg
If Sheets("Registos").Range("H" & inic) = Prod(1) And Sheets("Registos").Range("E" & inic) = "A" Then
FinalLinhaList = Sheets("LISTAS").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Registos").Range(Cells(inic, 1), Cells(inic, 17)).Copy Destination:=Sheets("LISTAS").Range("A" & FinalLinhaList + 1)
End If
Next inic

End Sub
 
Postado : 06/09/2017 5:11 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

lbranco,

Bom dia!

Por gentileza, anexe seu arquivo aqui mesmo no fórum, compactado com .ZIP.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 06/09/2017 5:51 am
leandroxtr
(@leandroxtr)
Posts: 447
Reputable Member
 

Cara, poste a planilha ou um exemplo idêntico com as informações diferentes.
Não da pra fazer testes apenas pelo código.

Se te ajudou, não se esqueça de dar um like na resposta e marcar o tópico como finalizado.

Abraços!
Leandro Cordeiro

 
Postado : 06/09/2017 5:55 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

lbranco

Percebi que você não conhece as regras do fórum, para facilitar a tua participação, sugiro tomar conhecimento do conteúdo dos links abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

[]s
Patropi - Moderador

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/09/2017 11:19 am
(@lbranco)
Posts: 5
Active Member
Topic starter
 

Não estou a conseguir adicionar o ficheiro ZIP com 262 KB

 
Postado : 07/09/2017 4:17 am
(@lbranco)
Posts: 5
Active Member
Topic starter
 

O que pretendo é que na planilha "Listas" seja feita uma listagem organizada dos dados da planilha "registos", ou seja, quero que organize por sectores e dentro destes por pavilhão e por sua vez dentro destes por tipo de produtos "Outro" .
onde está a dar erro é no comando:
Sheets("Registos").Range(Cells(inic, 1), Cells(inic, 17)).Copy Destination:=Sheets("LISTAS").Range("A" & FinalLinhaList + 1)
que está no Module1 na macro organizar().
Já utilizei este comando outras vezes e funcionou perfeitamente... não sei onde estou a errar.
Desde já o meu agradecimento

 
Postado : 07/09/2017 4:18 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

lbranco,

Continuo sem entender... como faço para chegar ao erro? Como é o processo? O que tenho que fazer para que o erro ocorra? Detalhe esse passo a passo.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 07/09/2017 8:23 am
(@lbranco)
Posts: 5
Active Member
Topic starter
 

Pretendo que ao chamar a macro Organizar() que se encontra no Module 1, esta organize Na planilha "LISTAS" os dados que constam na planilha "Registos" da seguinte forma: Sector A - Pavilhão A- M2 Ocupação de Terrado e seguintes que constam nas celulas de A3 a A29 da Planilha Preçario. E seguido Sector A -Pavilhão B - M2 Ocupação de Terrado e seguintes que constam nas celulas de A3 a A29 da Planilha Preçario . Sector A -Pavilhão C - M2 Ocupação de Terrado e seguintes que constam nas celulas de A3 a A29 da Planilha Preçario. E repete para o Sector B e C.
Planilha "Preçario"

Anexo folha de Excel onde está o exemplo do que pretendo. Desculpem talvez não ser a melhor maneira de inserir o exemplo mas não sei de outra forma.

 
Postado : 08/09/2017 4:59 am
(@lbranco)
Posts: 5
Active Member
Topic starter
 

Caros amigos, acho que já consegui o que pretendia, é claro que pode e deve ser aperfeiçoado, mas consegui o essencial.

Sub org()
Dim Prod(1 To 27) As String
Prod(1) = Sheets("Preçario").Range("B3")
Prod(2) = Sheets("Preçario").Range("B4")
Prod(3) = Sheets("Preçario").Range("B5")
Prod(4) = Sheets("Preçario").Range("B6")
Prod(5) = Sheets("Preçario").Range("B7")
Prod(6) = Sheets("Preçario").Range("B8")
Prod(7) = Sheets("Preçario").Range("B9")
Prod(8) = Sheets("Preçario").Range("B10")
Prod(9) = Sheets("Preçario").Range("B11")
Prod(10) = Sheets("Preçario").Range("B12")
Prod(11) = Sheets("Preçario").Range("B13")
Prod(12) = Sheets("Preçario").Range("B14")
Prod(13) = Sheets("Preçario").Range("B15")
Prod(14) = Sheets("Preçario").Range("B16")
Prod(15) = Sheets("Preçario").Range("B17")
Prod(16) = Sheets("Preçario").Range("B18")
Prod(17) = Sheets("Preçario").Range("B19")
Prod(18) = Sheets("Preçario").Range("B20")
Prod(19) = Sheets("Preçario").Range("B21")
Prod(20) = Sheets("Preçario").Range("B22")
Prod(21) = Sheets("Preçario").Range("B23")
Prod(22) = Sheets("Preçario").Range("B24")
Prod(23) = Sheets("Preçario").Range("B25")
Prod(24) = Sheets("Preçario").Range("B26")
Prod(25) = Sheets("Preçario").Range("B27")
Prod(26) = Sheets("Preçario").Range("B28")
Prod(27) = Sheets("Preçario").Range("B29")
Dim Sect(1 To 3) As String
Sect(1) = "A"
Sect(2) = "B"
Sect(3) = "C"

Dim Pav(1 To 4) As String
Pav(1) = "A"
Pav(2) = "B"
Pav(3) = "C"
Pav(4) = "EXT"

a = 1
b = 1
c = 1

FinalLinhaReg = Sheets("Registos").Range("B" & Rows.Count).End(xlUp).Row 'calcular ultimo registo
      
Sheets("LISTAS").Select

On Error Resume Next
  Cells.SpecialCells(xlCellTypeConstants).Clear
  On Error GoTo 0
  
FinalLinhaList = Sheets("LISTAS").Range("A" & Rows.Count).End(xlUp).Row 'calcular ultima linha da folha LISTAS
Sheets("LISTAS").Range("A" & FinalLinhaList + 3) = "."
Sheets("LISTAS").Range("G" & FinalLinhaList + 3) = "Listagem"

For a = 1 To 3 ' SECTOR
       For b = 1 To 4 ' PAV
         For c = 1 To 27 ' PROD
         
  For inic = 149 To FinalLinhaReg
   
             If Sheets("Registos").Range("F" & inic) = Pav(b) And Sheets("Registos").Range("H" & inic) = Prod(c) And Sheets("Registos").Range("E" & inic) = Sect(a) Then
             FinalLinhaList = Sheets("LISTAS").Range("A" & Rows.Count).End(xlUp).Row
             Sheets("LISTAS").Range("A" & FinalLinhaList + 5) = "."
             Sheets("LISTAS").Range("B" & FinalLinhaList + 5) = "SECTOR " & Sect(a)

             Sheets("LISTAS").Range("A" & FinalLinhaList + 6) = "."
             Sheets("LISTAS").Range("C" & FinalLinhaList + 6) = "PAVILHÃO " & Pav(b)

             Sheets("LISTAS").Range("A" & FinalLinhaList + 7) = "."
             Sheets("LISTAS").Range("D" & FinalLinhaList + 7) = Prod(c)
             Sheets("Registos").Range("A148:Q148").Copy Destination:=Sheets("LISTAS").Range("A" & FinalLinhaList + 8)
      
      GoTo verificar
      
      End If
      
    
  Next inic
  
    
      
verificar:
              For inicio = 149 To FinalLinhaReg
      
           If Sheets("Registos").Range("F" & inicio) = Pav(b) And Sheets("Registos").Range("H" & inicio) = Prod(c) And Sheets("Registos").Range("E" & inicio) = Sect(a) Then
           Inicsoma = Sheets("LISTAS").Range("K" & Rows.Count).End(xlUp).Row
           FinalLinhaList = Sheets("LISTAS").Range("A" & Rows.Count).End(xlUp).Row 'calcular ultima linha da folha LISTAS
           SegFinalLinhaList = FinalLinhaList + 1


           Sheets("Registos").Range(Sheets("Registos").Cells(inicio, 1), Sheets("Registos").Cells(inicio, 17)).Copy Destination:=Sheets("LISTAS").Range("A" & SegFinalLinhaList) ' & SegFinalLinhaList)
           Finalsoma = Sheets("LISTAS").Range("K" & SegFinalLinhaList).End(xlUp).Row

              If Inicsoma = Finalsoma Then
              cc = Cells(Inicsoma + 1, 11).Value
              Sheets("LISTAS").Range("K" & SegFinalLinhaList + 1) = cc
              Sheets("LISTAS").Range("K" & SegFinalLinhaList + 1).Select
              Selection.NumberFormat = "#,##0.00 $"
              SegFinalLinhaList = FinalLinhaList + 1
                 Else
                   cc = WorksheetFunction.Sum(Range(Cells(Inicsoma, 11), Cells(Finalsoma, 11)))
                   Sheets("LISTAS").Range("K" & SegFinalLinhaList + 1) = cc
                   Sheets("LISTAS").Range("K" & SegFinalLinhaList + 1).Select
                   Selection.NumberFormat = "#,##0.00 $"
                   SegFinalLinhaList = FinalLinhaList + 1
                 
              End If
              
              End If
           
        
    Next inicio
    
      Next c
        Next b
     Next a


  End Sub
 
Postado : 20/09/2017 9:30 am