Simplify Code for Copy/Paste Special

  • Thread starter Thread starter Active VBA
  • Start date Start date
A

Active VBA

Is there a way to simplify this code below?
If you could please suggest a revised code, it would be greatly
appreciated. Thanks.


Sub update_analysis()
'
' Macro recorded July 2008
'

'
Application.ScreenUpdating = False
Sheets("Interest").Select
Range("E28:DI28").Select
Selection.Copy
Range("E29").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("G5").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Principal").Select
Range("E28:DI28").Select
Selection.Copy
Range("E29").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("G5").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Leasing Analysis").Select
Range("A2").Select
Application.ScreenUpdating = True
End Sub




Thank you for your help in advance.

Best regards,

Active VBA
 
Hi

It could look like this:

Sub update_analysis()
'
' Macro recorded July 2008
'

'
Application.ScreenUpdating = False
Sheets("Interest").Select
Range("E28:DI28").Copy
Range("E29", Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("G5").Value = Date & " " & Format(Time, "hh:mm")

Sheets("Principal").Select
Range("E28:DI28").Copy
Range("E29", Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("G5").Value = Date & " " & Format(Time, "hh:mm")

Sheets("Leasing Analysis").Select
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Regards,
Per
 
Something like this?

Sub update_analysis()
Application.ScreenUpdating = False
with Sheets("Interest")
.Range("E28:DI28").Copy
.Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteValues
.Range("G5")=date
end with

with Sheets("Principal")
.Range("E28:DI28").Copy
.Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteValues
.range("g5")=date
end with

'shouldn't be necessary
'Sheets("Leasing Analysis").Select
'Range("A2").Select

Application.ScreenUpdating = True
End Sub
 
.Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteValues
Actually should be
..Range(Range("e29"), Range("E29").End(xlDown)).PasteSpecial
Paste:=xlPasteValues

Try this further simplification and correction
Sub sheetsinarray()
myarray = Array("Interest", "Principal")
For Each Sh In myarray
With Sheets(Sh)
.Range("E28:DI28").Copy
.Range(Range("e29"), Range("E29").End(xlDown)) _
.PasteSpecial Paste:=xlPasteValues
.Range("G5") = Now 'Date
End With
Next Sh
End Sub
 
Code: 
Dim SheetName as Variant
For Each SheetName in Array("Interest,"Principal")
   With ActiveWorkbook.Sheets(SheetName)
       With .Range("E28: DI28")
           .Cells(2,1).End(xlDown)).Resize(1,.Columns.Count).Value = .Value
       End With
       .Range("G5").Value = Now()
   End With
Next SheetName
With ActiveWorkbook.Sheets("Leasing Analysis")
    .Activate
    .Range("A1").Select
End with
 
 .Range("E29").End(xlDown)).PasteSpecial Paste:=xlPasteValues
Actually should be
.Range(Range("e29"), Range("E29").End(xlDown)).PasteSpecial
Paste:=xlPasteValues

Try this further simplification and correction
Sub sheetsinarray()
myarray = Array("Interest", "Principal")
For Each Sh In myarray
With Sheets(Sh)
    .Range("E28:DI28").Copy
    .Range(Range("e29"), Range("E29").End(xlDown)) _
         .PasteSpecial Paste:=xlPasteValues
    .Range("G5") = Now 'Date
End With
Next Sh
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software










- Show quoted text -
Click to expand...

Code you suggest did not work for some reason.?? Any suggestions.
Thanks, V.
 
Code you suggest did not work for some reason.?? Any suggestions.
Thanks, V.- Hide quoted text -

- Show quoted text -
Click to expand...

any help on this will be greatly appreciated..............will keep my
spreadsheet to a manageable size (under 4 Meg as opposed to 34 Meg)
 
If desired, send your workbook to my address below along with snippets of
these emails and a clear explanation of what you want to happen along with
before/after examples.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Code you suggest did not work for some reason.?? Any suggestions.
Thanks, V.- Hide quoted text -

- Show quoted text -
Click to expand...

any help on this will be greatly appreciated..............will keep my
spreadsheet to a manageable size (under 4 Meg as opposed to 34 Meg)
 
If desired, send your workbook to my address below along with snippets of
these emails and a clear explanation of what you want to happen along with
before/after examples.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software





any help on this will be greatly appreciated..............will keep my
spreadsheet to a manageable size (under 4 Meg as opposed to 34 Meg)
Click to expand...

Imagine a spreadsheet that has 2 tabs (“interest” and “principal”).
The objective is to copy the formulae from cell E28:DC28, and paste
the formulae down to, let’s say, row 500. Once this is done, all the
cells that we pasted should now turn into hard coded values on each of
these two tabs. The purpose is to save file space. If you could
kindly provide me with a better way to do this than I have shown, it
would be much appreciated.

V.
 
I prefer TOP posting. Based on what you have told me, I thought that's what
I provided. I repeat my offer.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
If desired, send your workbook to my address below along with snippets of
these emails and a clear explanation of what you want to happen along with
before/after examples.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software





any help on this will be greatly appreciated..............will keep my
spreadsheet to a manageable size (under 4 Meg as opposed to 34 Meg)
Click to expand...

Imagine a spreadsheet that has 2 tabs (“interest” and “principal”).
The objective is to copy the formulae from cell E28:DC28, and paste
the formulae down to, let’s say, row 500. Once this is done, all the
cells that we pasted should now turn into hard coded values on each of
these two tabs. The purpose is to save file space. If you could
kindly provide me with a better way to do this than I have shown, it
would be much appreciated.

V.
 
Rule #1: *Never* use Cut Copy and Paste methods in macros, because the user
might be multi-tasking, and you're messing with the *Window* clipboard.

OK, here's how to do all this without CCP, and faster too:

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With Worksheets("Interest")

With .Range("DI28", .Range("E29").End(xlDown)) ' Define upper right
to lower left corners of whole range

.Rows(1).AutoFill .Cells, xlFillCopy ' copies formulas with
relative addressing
Application.Calculate ' recalculates formulas
.Cells.Value = .Cells.Value ' replaces formulas with values

End With

.Range("G5").Value = Now() ' Not the Excel function, the VBA function

End With

With Worksheets("Principal")
' same code block
End With
 
Back
Top