Copy data to another sheet

Microsoft Excel 2003 (full product)
April 6, 2010 at 02:41:25
Specs: Windows XP
I would like to copy some cells with a "X" in column C to a new worksheet.

Sheet A
First cell = C21
C D E F G ---- H--- ...
X 2 A 10 20 ----100--- ...
0 3 B 10 0 ---200---...
X 4 A 10 20 ---300---...

Sheet 2
First cell = E81

2 A 10 20
4 A 10 20


See More: Copy data to another sheet

April 6, 2010 at 05:51:32

The following macro finds all cells in column C, starting at row 21, containing "X" and copies columns D to G on those rows to Sheet2 starting at cell E81.

Run the macro from a command button on Sheet1
On the source Worksheet (Sheet1), 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 'Copy X rows' or something 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 rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngDestStart As Range
Dim rngCell As Range
Dim intDestOffset As Integer

'turn off screen updating to reduce flicker
Application.ScreenUpdating = False

On Error GoTo ErrHnd

'set start of source data
Set rngSrcStart = Worksheets("Sheet1").Range("C21")
'find end of source data
Set rngSrcEnd = Worksheets("Sheet1") _
            .Range("C" & CStr(Application.Rows.Count)).End(xlUp)
'set start of destination
Set rngDestStart = Worksheets("Sheet2").Range("E81")

'set destination row offset counter to zero
intDestOffset = 0

'loop through source data
For Each rngCell In Worksheets("Sheet1").Range(rngSrcStart, rngSrcEnd)
    'test for X
    If rngCell.Text = "X" Then
        'copy 4 columns (D to G)
        rngCell.Offset(0, 1).Resize(1, 4).Copy
        'paste to destination
        rngDestStart.Offset(intDestOffset, 0) _
                .PasteSpecial xlPasteFormulasAndNumberFormats
        'increment offset counter
        intDestOffset = intDestOffset + 1
    End If
Next rngCell

'remove copy marquee
Application.CutCopyMode = False

'turn screen updating back on
Application.ScreenUpdating = True
Exit Sub

'error handler
'turn screen updating back on
Application.ScreenUpdating = True
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).

As Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

Click the 'Copy X rows' button to run the macro.


Report •

April 6, 2010 at 22:51:45
Thank you for your responses.
I used this macro and... it worked.

Report •
Related Solutions

Ask Question