Copy data from one sheet to another using VBA

June 30, 2010 at 20:34:24
Specs: Windows XP
I have a report that I would like to be able to separate based on the Value of Column L. For example if Row 2 Column L = "P100278" then copy and paste the entire row into Sheet "Alpha". The report is in Sheet "Source"

An example of some of the Values and relative Sheets are as below, noting some of the values relate to the same sheet:

Value: Sheet Name:
P100278 CPL Distance
P010129 CPL
P100279 SGT Distance
P010130 SGT
P100663 DENT SPVR
P103925 STM
P103274 STM
P103278 STM

I have browsed many other peoples questions and have tried to apply their answers to my problem however I keep getting stuck.

As I have many other values and sheets, a brief outline of how to add to the macro would be fantastic.

Any help would be much appreciated.


See More: Copy data from one sheet to another using VBA

Report •


#1
July 1, 2010 at 04:48:43
Hi,

There are several approaches to this issue. To decide on the best approach there are some questions that need to be answered:

1. Will this 'move from source sheet to destination sheets' happen just once, or will it be repeated as data is added to the source.
2. Will any of the rows that have been moved to destination sheets ever be changed - i.e., will you need to update data that has already been moved
3. Do any of the sheet names change for a single row. For example if L2 is SGT, will it ever be changed and need to be removed from SGT and placed on another destination sheet.
4. Do you want whole rows copied, or just certain columns, e.g., A to M
5. Will new worksheet names need to be added - the simpler code is to assume that all required destination sheets are already present. A more complicated code will search to see if the sheet is present and add it if it's not. This makes the code more 'generic' - it can cope with new destination sheet names as they come along.
6. Once copied to the destination sheet, do you want that row of source data to be removed - in other words is this a cut and paste or is it a copy process. (also depends on answers to Q2 & Q3).
7. Do you need instructions on how to add and run your macro, or do you just need the code.

Regards


Report •

#2
July 1, 2010 at 15:13:42
Hi Humar, thanks for responding:

1. The report will be generated every week, the old data will not need to be kept as new reports will contain previously obtained data.

2.Data will not need to be edited as this will be updated weekly.

3. No but a row might need to go into 2 sheets (sorry if that doesn't make sense).

4. Yes I would like whole rows to be copied.

5. It is possible that new sheets will be required in the future.

6. I would prefer copy and paste, I know that will result in duplication of information but I prefer to keep a "master" for just-in-case scenarios.

7. I should be right just with the Macro, but a few comments within to be able to change in the future would be great.

Thanks again.

Stu


Report •

#3
July 8, 2010 at 06:23:38
Hi,

I have a macro that appears to do what you want, including allowing some rows to be copied to two destinations.

What I have noticed is that you do not have worksheet names alongside the data in column L

As a result the link from data to worksheet is hard-coded.

This is probably OK if you don't have many unique data values in column L.

The macro and some instructions are included below. When you have looked at this you might consider the hard-coding too laborious. If so you could add say two columns to the source worksheet and have the destination name(s) for each value in Column L. The macro would use these worksheet names.

To test the macro you will need a worksheet named "Duplicates" - it is used as a test for copying one of the rows to a second worksheet.
All other worksheet names are assumed to exist - they are not created by this macro.

Anyway try this and let me know if you want to change your approach.
(The macro pops up a message if a value in L has not been hard-coded with a destination worksheet)

On the "Source" 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 'Copy data' 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 strThisWs As String
Dim wsEach As Worksheet
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim rngDest As Range

On Error GoTo ErrHnd

'clear destination worksheets
'keep the name of the calling sheet
strThisWs = ActiveSheet.Name
'loop through all worksheets in the workbook
For Each wsEach In ActiveWorkbook.Worksheets()
    'only clear the worksheet if it is NOT the calling worksheet
    'or one named "Source" - add other sheet names as required
    If wsEach.Name <> strThisWs And wsEach.Name <> "Source" Then
        'offset one row to leave header row intact
        'this method requires that there is at least one unused row
        'below the data and the bottom of the worksheet
        wsEach.UsedRange.Offset(1, 0).Cells.Clear
    End If
Next wsEach

With Worksheets("Source")
    'set start as L2 i.e., after heading row in column L
    Set rngStart = .Range("L2")
    'set end - last used row in column L
    Set rngEnd = .Range("L" & CStr(Application.Rows.Count)).End(xlUp)
    
    'loop through cells in column L
    For Each rngCell In .Range(rngStart, rngEnd)
        'test data in column L and move to required worksheet
        Select Case rngCell.Text
            '***********
            Case "P100278"
            'find next empty row on destination sheet
            'End (xlup) finds last used row, so offset 1 row
            Set rngDest = Worksheets("CPL Distance") _
                    .Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Offset(1, 0)
            'copy & paste entire row
            rngCell.EntireRow.Copy _
                Destination:=Worksheets("CPL Distance") _
                        .Range(rngDest.Address)
            '***********
            Case "P010129"
            Set rngDest = Worksheets("CPL") _
                    .Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Offset(1, 0)
            rngCell.EntireRow.Copy _
                Destination:=Worksheets("CPL") _
                    .Range(rngDest.Address)
             '***********
            Case "P100663"
            'this one goes to two destination sheets
            'first sheet
            Set rngDest = Worksheets("DENT SPVR") _
                    .Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Offset(1, 0)
            rngCell.EntireRow.Copy _
                Destination:=Worksheets("DENT SPVR") _
                    .Range(rngDest.Address)
            'second sheet
              Set rngDest = Worksheets("Duplicates") _
                    .Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Offset(1, 0)
            rngCell.EntireRow.Copy _
                Destination:=Worksheets("Duplicates") _
                    .Range(rngDest.Address)
            '**********
            Case Else
            'catch any unallocated values in column L
            MsgBox "No destination sheet has been allocated for: " _
                    & rngCell.Text
        End Select
    Next rngCell
End With
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).

As changes made by 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 data' button to run the macro

Regards


Report •

Related Solutions

#4
July 8, 2010 at 15:18:12
Hi Humar,

Thank you for your time with this code.

How does this macro handle these codes and relative worksheet?

P103925 STM
P103274 STM
P103278 STM

I have approx 25 codes with roughly 20 possible worksheets, I'm imagining that this will be quite difficult for me to continue hardcoding. Any suggestions for making this easier?

Many thanks,

Stuart


Report •

#5
July 8, 2010 at 15:36:20
Hi,

I just entered a few code/sheet relationships to prove that the code worked - I was leaving the hard work of adding them all to you !

You would have to repeat the Case blocks with the relevant data.

Just repeat this block with the relevant changes:

            Case "P100278"
            'find next empty row on destination sheet
            'End (xlup) finds last used row, so offset 1 row
            Set rngDest = Worksheets("CPL Distance") _
                    .Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Offset(1, 0)
            'copy & paste entire row
            rngCell.EntireRow.Copy _
                Destination:=Worksheets("CPL Distance") _
                        .Range(rngDest.Address)

Alternatively, as I suggested, you could have an extra two columns, with the worksheet name (or names for duplicate copies) alongside the codes.

Another option is to create a separate table on a different worksheet, listing the codes and the worksheets to copy them to.

A table might be the easiest to manage in the long-term as new codes and changes to worksheet allocations could be made without touching the code, and independent of your source data.
If you had this:

	A	B		C		D		E
1	Code	# sheets	Sheet #1	Sheet # 2	Sheet #3
2	P123	1		STM		
3	P456	3		STM		CPL		DENT SPVR

The table would be pretty flexible and it should be relatively easy to add code to the macro to use the table, rather than the present hard-coded relationships.

Let me know if you can go down one of these routes.

Regards


Report •

#6
July 13, 2010 at 19:39:19
Thanks Again

Report •

#7
October 12, 2010 at 09:45:15
I would like to use this macro, but I have over a hundred items, so I would need a hundred "cases", to distribute to just three sheets. How would I use a table in my macro to reference all these items, instead of making a new case for each item?

Report •


Ask Question