Boa tarde!!
Veja o código com um detalhe a mais (limpar os campos na guia NOVO)
Sub AleVBA_14677V2()
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Set wsSrc = Worksheets("Novo")
Set wsDst = Worksheets("Base de Dados")
Application.ScreenUpdating = False
With wsSrc
.Range("Y6").FormulaR1C1 = "=R[25]C[-6]"
.Range("Y7").FormulaR1C1 = "=RC[-21]"
.Range("Y8").FormulaR1C1 = "=R[-1]C[-7]"
.Range("Y9").FormulaR1C1 = "=R[1]C[-21]"
.Range("Y10").FormulaR1C1 = "=RC[-13]"
.Range("Y11").FormulaR1C1 = "=R[-1]C[-9]"
.Range("Y12").FormulaR1C1 = "=R[-2]C[-6]"
.Range("Y13").FormulaR1C1 = "=RC[-21]"
.Range("Y14").FormulaR1C1 = "=R[-1]C[-14]"
.Range("Y15").FormulaR1C1 = "=R[-2]C[-7]"
.Range("Y16").FormulaR1C1 = "=R[1]C[-21]"
.Range("Y17").FormulaR1C1 = "=RC[-7]"
.Range("Y18").FormulaR1C1 = "=R[2]C[-21]"
.Range("Y19").FormulaR1C1 = "=R[1]C[-13]"
.Range("Y20").FormulaR1C1 = "=RC[-9]"
.Range("Y21").FormulaR1C1 = "=R[-1]C[-6]"
.Range("Y22").FormulaR1C1 = "=R[2]C[-21]"
.Range("Y23").FormulaR1C1 = "=R[1]C[-10]"
.Range("Y24").FormulaR1C1 = "=RC[-6]"
.Range("Y25").FormulaR1C1 = "=R[2]C[-21]"
.Range("Y26").FormulaR1C1 = "=R[1]C[-14]"
.Range("Y27").FormulaR1C1 = "=RC[-10]"
.Range("Y28").FormulaR1C1 = "=R[6]C[-6]"
.Range("Y29").FormulaR1C1 = "=R[3]C[-21]"
End With
wsSrc.Range("Y6:Y29").Value = wsSrc.Range("Y6:Y29").Value
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
With wsDst
wsSrc.Range("Y6:Y29").Copy
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
.Columns.AutoFit
wsSrc.Range("Y6:Y29").ClearContents
End With
Range("D7:N8,R7:V8,S10:V11,P10:P11,L10:N11,D10:I11,D13:G14,K13:O14,R13:V14,R17:V18,S20:V21,P20:P21,L20:N21,D20:I21,D17:M18,S24:T25,O24:P25,D24:L25,D27:G28,K27:L28,O27:P28,S31:V32,S34:V35,D32:O40").Select
Selection.ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Att
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 19/02/2015 1:02 pm