Pergunta:
A mascara que disponibilizou, sempre iniciará com 12 linhas, ou eventualmente poderá iniciar como mais?
Sempre irá variar, pois depende do ultimo orçamento que fiz.
Já consegui resolver, ficou bem comprido.
Para gravar o orçamento:
Sub testesdiversos()
Dim LastRow As Long, qtdprodutos As Long, Data As String, resposta As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Data = Format(DateTime.Now, "dd/mm/yyyy - hh:mm:ss")
resposta = InputBox("Descrição do Orçamento", "Entrada de Dados")
If resposta = Empty Then
Else
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ActiveSheet.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Select
qtdprodutos = ActiveCell.Offset(1, 5)
End With
Range("C22", Cells(LastRow, 3)).Copy
Sheets("BDORCAMENTOS").Select
Range("B6").Select
Selection.ColumnWidth = 32.01
ActiveSheet.Paste
Range("B1") = ActiveCell.Column + 1000
Range("B2") = resposta
Range("B3") = Data
Range("B4") = LastRow - 21
Range("B5") = qtdprodutos
Range("B1:B5").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Sheets("Cadastro").Select
Application.EnableEvents = True
End If
End Sub
Para retomar o número de linhas e valores:
Sub testes2()
Dim LastRow As Long, linhasorcamento As Long, qtdprodutos As Long, Lista As Long, linhas3 As Long, linhas2 As Long, Data As String, resposta As String, linhas As String, produtos As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("BDORCAMENTOS").Select
resposta = Range("B2").Value
Data = Range("B3").Value
linhas = Range("B4").Value
produtos = Range("B5").Value
Sheets("Cadastro").Select
With ActiveSheet
Rows("22:22").Select
Selection.Copy
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ActiveSheet.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Select
End With
Lista = LastRow - 21
linhas2 = Lista - linhas
If linhas2 = 0 Then
Else
If linhas2 < 0 Then
ActiveCell.Offset(1, 0).Rows("1:" & -linhas2).EntireRow.Select
Selection.Insert Shift:=xlDown
Else
linhas3 = linhas2 + 1
ActiveCell.Offset(-linhas3, 0).Rows("1:" & linhas2).EntireRow.Delete
End If
End If
Sheets("BDORCAMENTOS").Select
linhasorcamento = Range("B4").Value + 5
Range("B6", Cells(linhasorcamento, 2)).Select
Selection.Copy
Sheets("Cadastro").Select
Range("C22").Select
ActiveSheet.Paste
Application.EnableEvents = True
End Sub
Agora vou ter que fazer uma interface para escolher os rascunhos salvos, além de fazer um mecanismo que possa salvar e remover os rascunhos dos orçamentos. Devo criar outros tópicos para isso, pois são assuntos diferentes
Vlw pela ajuda !!
Postado : 21/08/2012 1:21 pm