Excel Macro Copy data to next sheet using < [Solved/Closed]

Report
-
Posts
2658
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 28, 2020
-
Hello,

I'm looking some time now around this forum and ditn't find what i'm looking for. So i'm just gonna ask it here and hopefully someof your smart guys can help me out.

I have 1 Excel file with 4 sheets in it.

The first sheet is the "work" sheet. In this one there will be the data inserted.
The data containing for example:

A B
11,7 WBM1
6,1 WHS501/2
10,6 WHS501/1
10,6 WM501
7,1 WLSH401
6,4 WLS401

The 3 other sheets are named "small", "medium" and "large". The idea is that the data in the second column B will be copied to the 3 sheets when in the first column A the following conditions are meet...
<10 to sheet "small"
<20 but >10 to sheet "medium"
<30 but >20 to sheet "large"

So for example:
WBM1 will be placed in sheet "medium" column A
WHS501/2 will be placed in sheet "small" column A
...

I want this to be done automaticly and not by pressing a button.

I thank you guys for your effort.

1 reply

Posts
2658
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 28, 2020
440
Hi Gino,

Let's start by looking at your conditions:
<10 to sheet "small"
<20 but >10 to sheet "medium"
<30 but >20 to sheet "large"

This way values 10 and 20 will be skipped, so I changed it into:
<10 to sheet "small"
<20 but >=10 to sheet "medium"
<30 but >=20 to sheet "large"
Find the conditions in the code and change into anything you would like.

Since you want the code to run automatically, I am wondering WHEN you want the code to run automatically?

Currently I have set the code to run when you deactivate the sheet "work".
Here is the code:
Private Sub Worksheet_Deactivate()
Set MR = Range("A1:A10")

For Each cell In MR

If cell.Value < 10 Then
    cell.Offset(0, 1).Copy
    Sheets("small").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        End If
If cell.Value >= 10 And cell.Value < 20 Then
    cell.Offset(0, 1).Copy
    Sheets("medium").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        End If
If cell.Value >= 20 And cell.Value < 30 Then
    cell.Offset(0, 1).Copy
    Sheets("large").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        End If
            Next
Application.CutCopyMode = False
End Sub

You implement the code by right-clicking the tab of sheet "work" and selecting "view code". Then paste the code in the big white empty field.

When you have done this, you will see on top of the field you pasted in two dropdown lists. Take a look at the one saying "deactivate". This list contains the options for running your code automatically.

Keep in mind that each time you run the code that all the values already being pasted will be pasted again.

Best regards,
Trowa