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.
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
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 + 2with :
ActiveCell.Offset(1, 0).EntireRow.Insert
Let me know!
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 SubYou 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
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
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.
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
