Macro to copy, paste and insert rows of data

February 25, 2010 at 08:51:50
Specs: Windows XP

Hi,

I need to develop a macro that will read all data in one worksheet ("Data") and copy/paste it into another worksheet ("Report"), inserting a new row for each row copied from the other worksheet ("Data").

The five columns in both sheet are the same. The data in ("Data") starts on A2 and will be copied onto A5 in ("Report"). But the "Report" sheet is formatted for visual display/presentation. So the insertion of a new row is important here.

Any help would be appreciated!

Thank you.


See More: Macro to copy, paste and insert rows of data

Report •


#1
February 25, 2010 at 10:06:56

Hi,

The following macro copies data from a worksheet named "Data" starting at cell A2, and down to the last row with data, and copies five columns of data per row.

The Data is copied to alternate rows on a worksheet named "Report" starting at Row 5 (cell A5)

To use this macro, create a button and attach the code to it:
On the "Data" Worksheet, create a command button from the Control Toolbox toolbar.
(If this isn't visible, right click on an existing toolbar and check the Control Toolbox).
Select the button Icon and draw a button
Right-click the button and select Command Button - Edit and change the name to 'Report' or something else suitable.
Right-click the button again and select View Code
In the code window that opens enter this:

Option Explicit

Private Sub CommandButton1_Click()
Dim rngDest As Range
Dim rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngCell As Range
Dim intOffset As Integer

On Error GoTo ErrHnd

'set start of source range
Set rngSrcStart = Worksheets("Data").Range("A2")

'set end of source range
Set rngSrcEnd = Worksheets("Data"). _
           Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'set destination range start
Set rngDest = Worksheets("Report").Range("A5")

'set destination offset
intOffset = 0

'get each row of source data
For Each rngCell In Range(rngSrcStart, rngSrcEnd)
    'copy five columns to destination row
    rngCell.Resize(1, 5).Copy Destination:=rngDest.Offset(intOffset, 0)
    'jump a row
    intOffset = intOffset + 2
Next rngCell
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

Note that Private Sub CommandButton1_Click() and End sub will already be present, so don't duplicate them. Option explicit goes before Private Sub CommandButton1_Click().
Some lines of code have been split onto two lines for ease of viewing, using the line continuation character "_". This should work 'as is' just copy and paste, or you could remove the "_" and bring the code back to one line.

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.
Exit design mode (first icon on the Controls Toolbox toolbar).

Test this macro on sample data. The changes cannot be undone with the Undo button. Always make a backup of your data before running this macro.

Hope this is what you were looking for.

Regards


Report •

#2
February 25, 2010 at 10:39:43

Thank you! The codes worked perfectly on my spreadsheet.

Question - instead of pasting the data on alternate rows. Is there a way to insert a new row and paste the data in the new row?

Because the report is designed to look like a 'listbox' with formulas and visual graphics below the data copied from "Data." The current codes would overwrite the comments. I believe it would be something like replacing:

'jump a row
intOffset = intOffset + 2

with :

ActiveCell.Offset(1, 0).EntireRow.Insert

Let me know!


Report •

#3
February 25, 2010 at 13:19:17

Hi,

Without actually having your destination data it is difficult to know exactly what is going to work.

Here is a modification of the code. I suggest you try it with different offset values.

Option Explicit

Private Sub CommandButton1_Click()
Dim rngDest As Range
Dim rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngCell As Range
Dim intOffset As Integer

On Error GoTo ErrHnd

Application.ScreenUpdating = False

'set start of source range
Set rngSrcStart = Worksheets("Data").Range("A2")

'set end of source range
Set rngSrcEnd = Worksheets("Data"). _
        Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'set destination range start
Set rngDest = Worksheets("Report").Range("A5")

'set destination offset
intOffset = 0

'get each row of source data
For Each rngCell In Range(rngSrcStart, rngSrcEnd)
    'insert a new destination row
    rngDest.Offset(intOffset, 0).EntireRow.Insert
    'copy five columns to destination row
    rngCell.Resize(1, 5).Copy
    rngDest.Offset(intOffset, 0).PasteSpecial (xlPasteValues)
    'jump a row
    intOffset = intOffset + 2
Next rngCell
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.ScreenUpdating = True
End Sub

You will see that I have made two other changes.
1. I have used PasteSpecial - paste values, so that formatting is not carried over from the Data sheet into your formatted report sheet (other options are available - see PasteSpecial Help in the VB Window and look at the xlPasteType list).

2. I have turned off screen updating to stop the flicker during the copy and paste procedures

I suggest trying adjustments such as
rngDest.Offset(intOffset -1, 0).PasteSpecial (xlPasteValues)
or
rngDest.Offset(intOffset +1, 0).PasteSpecial (xlPasteValues)

Another thought is to have a copy of the cells with the required formatting saved on the Data sheet, and as a last step copy those cells and PasteSpecial - Formats.

Regards


Report •

Related Solutions

#4
May 5, 2010 at 01:45:34

Hi

I have just used your formula and it works fine (Thanks very much) but some of my source data might have some empty rows, How do I delete the empty rows before the copy and insert and also delete the empty rows in the destination data? Please


Report •

#5
September 11, 2010 at 08:18:48

Thanks for this formula it works well I have one problem the list I am taking the data from has formulas in some of the cells. When it takes it to the new table it is taking the formula where I just want the values. Is there a way to change the expression so it will only take the values and no formulas.

Report •

#6
September 11, 2010 at 09:10:25

Hi pezram,

Look at response #3.

I provided a modification of the code that separates the one line Copy/Paste into two lines.
The first line is a copy and the second line is a PasteSpecial - Paste Values:

    rngCell.Resize(1, 5).Copy
    rngDest.Offset(intOffset, 0).PasteSpecial (xlPasteValues)

This just pastes the cell values - no formulas and no formatting.
You could use xlPasteFormulasAndNumberFormats instead of xlPasteValues and this allows you to retain any number formatting with the values.

Regards


Report •


Ask Question