Macro Copy cells and Insert/shift down

[Bern Notice]

Trying to write a macro that highlights a range of cells across 9 columns and
inserts them above a total line. Meaning that the total line needs to shift
down to remain. Any ideas?

 

[Barb Reinhardt]

Try recording a macro that does exactly what you want. Come here and post
it if you want help cleaning it up. Give specifics of things you might want
to change including:

Which worksheet do you want to do this on.
Do you want to run it at any group of selected cells?

Things like that.

HTH,
Barb Reinhardt

 

[Bern Notice]

Thanks for your response Barb. Below is the bottom part of my macro and it
is stopping at the point where it tries to copy the contents of the cells
(which will have varying numbers of rows) from a sheet titled "Quickbooks
Import" and then tries to insert them into another sheet titled "Medical
2009". One problem I may have is that there really is only data in columns
A-E on the "Quickbooks Import" sheet. But When doing it manually, I had to
highlight columns A-I because there totals under those columns on sheet
"Medical 2009" that need to be moved down as well when the data is pasted.
(Manually, I used the Insert Copied Cells and then chose the shift down
option).

I need the cells inserted above a total line (which is 2 rows below the last
row of data in column A) on sheet "Medical 2009". In other words, I want my
total line to shift down when the data is pasted in. Each time we run this
macro, we need to insert the new data above that total line.

The macro stops at the line - - Range("A"&lastrow+1).PasteSpecial
Paste:=xlValues -- which is about 11 or 12 rows from the bottom and returns
a message that says...
"Run Time Error-1004. The information cannot be pasted because the copy
area and the paste area are not the same size and shape."


Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A1:I" & lastrow).Copy
Sheets("Medical 2009").Activate
lastrow = Sheets("Medical 2009").Cells(Cells.Rows.Count,
"A").End(xlUp).Row
Range("A"&lastrow+1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("D2").FormulaR1C1 = "='Quickbooks Import'!R[" & lastrow & "]C"
Range("D2").AutoFill Destination:=Range("D2:E2"), Type:=xlFillDefault
Range("D2:E2").Copy
Range("D2:E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Quickbooks Import").Activate
Range("A1:I" & Cells(Rows.Count, 1).End(xlUp).Row + 5).ClearContents
Range("A1").Select
Sheets("Medical 2009").Select

 

[CurlyDave]

You can Change the copy and pastecode to something like this

Sub Button1_Click()
'Range("A1:I" & lastrow).Copy
' Sheets("Medical 2009").Activate
' lastrow = Sheets("Medical 2009").Cells(Cells.Rows.Count, "A").End
(xlUp).Row
' Range("A" & lastrow + 1).PasteSpecial Paste:=xlValues
Dim r As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("Medical 2009")
Set r = Range("A1", Range("I65536").End(xlUp))
r.Copy
ws.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
xlPasteValues

Application.CutCopyMode = false
End Sub