Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro gravada sobre...
 
Notifications
Clear all

Macro gravada sobrepondo historico

 
2024 - VBA & Macros
5 Posts
2 Usuários
0 Reactions
1,046 Visualizações
RSS
 Rafajunio
(@rafajunio)
Posts: 0
New Member
Topic starter
 

Boa noite,

Pessoal estou fazendo uma planilha para um amigo, e estou com um problema na gravação de uma macro, ela esta sobrepondo os dados ao invés de seguir em sequencia, alguem pode me ajudar?

1º a planilha consiste em armazenar um histórico de valores vendido por dia por um dos funcionários.
2º preciso armazenar todos os dias um debaixo do outro, ex dia 10/11/2016 na proxima salvação o 11/11/2016 deve ficar debaixo da data anterior, porém quando clico no botão ele sobrepoem os dados anterior

dem uma olhada no meu codigo 

Sub Historico()
'
' Historico Macro
' Historico

    Range("C8:J21").Select
    Selection.Copy
    Sheets("Historico").Select
    Range("A2").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveSheet.Paste
    Range("A3:A13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C8").Select
    Application.CutCopyMode = False
    Range("A17").Select
End Sub
 
Postado : 04/03/2016 9:54 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Poderia ser +/- assim:

Sub Historico()
' Historico
Dim sPlanAtiva
Dim lastRow As Long
sPlanAtiva = ActiveSheet.Name
'Determinando ultima linha preenchida na planilha historico
lastRow = Sheets("Historico").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

ActiveSheet.Range("C8:J21").Copy
Sheets("Historico").Select
Range("A" & lastRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(sPlanAtiva).Select
Application.CutCopyMode = False
End Sub
 
Postado : 05/03/2016 6:30 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Rafajunio

Movi teu tópico para VBA & Macros, que é o assunto da tua dúvida.

[]s

Patropi - Moderador

 
Postado : 05/03/2016 7:20 am
 Rafajunio
(@rafajunio)
Posts: 0
New Member
Topic starter
 

Poderia ser +/- assim:

Sub Historico()
' Historico
Dim sPlanAtiva
Dim lastRow As Long
sPlanAtiva = ActiveSheet.Name
'Determinando ultima linha preenchida na planilha historico
lastRow = Sheets("Historico").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

ActiveSheet.Range("C8:J21").Copy
Sheets("Historico").Select
Range("A" & lastRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(sPlanAtiva).Select
Application.CutCopyMode = False
End Sub

Ficou quase perfeito maninho, agradeço sua ajuda de mais, mas se puder continuar a me ajudar eu agradeço.

O que está rolando agora é que não esta copiando a formatação da planilha para a pllanilha historico.
na que eu gravei eu retirava apenas a formatação da coluna A, pois continha a formula =hoje() e o histórico tem que gravar as datas certinhas, nas demais eu deixava para dar uma aparecia bacana, como linhas de grade e cores.
sabe em qual parte eu posso, mexer para que eu não perca essa formatação ?

 
Postado : 05/03/2016 9:09 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Manter perfumaria em Historico, para mim e novidade.
Talvez assim:

Sub Historico()
' Historico
Dim sPlanAtiva
Dim lastRow As Long
sPlanAtiva = ActiveSheet.Name
'Determinando ultima linha preenchida na planilha historico
lastRow = Sheets("Historico").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Range("C8:J21").Copy
Sheets("Historico").Select
Range("A" & lastRow).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(sPlanAtiva).Select
Range("A" & lastRow).Select
ActiveSheet.Range("C8:J21").Copy
Sheets("Historico").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Columns("A:H").EntireColumn.AutoFit
Sheets(sPlanAtiva).Select
Application.CutCopyMode = False
End Sub
 
Postado : 06/03/2016 6:40 am
Forum Jump:
  Tópico Anterior
Próximo Tópico