Filling data from Sheet1 to Sheet2 with two or more conditions.

[Mark00963]

Greeting,
First of all, thank you very much for such a site and it has been so helpful for me.

Problem: so I'm doing an almost daily task which I couldn't do it by macros, I'll explain it by an example;

For example, let's say that here I have the following table in Sheet1:
Order No Color S M L XL XXL 2XL S-M L-XL STANDART
S11G1371 BLAZE 10 20 20 20 10
S11G1299 GREEN 5 10 10 10 5
S11G1299 SOMON 5 10 10 10 5
S11G1205 DARK GREY 5 9 9 9 5
S11G1204 NAVY 6 12 12 12 6
S11G1206 ECRU 5 8 8 8 4
S11G1310 GREY 4 7 7 7 4

almost every day I have to fill the amounts under columns S M L XL...etc. to a similar table as the following in Sheet2:

Order No Color S M L XL XXL 2XL S-M L-XL STANDART
S11G1275 YELLOW
S11G1287 PURPLE 2 4 4 4 2
S11G1298 BLUE 2 2 2 2 1
S11G1298 YELLOW 1 2 2 2 1
S11G1299 GREEN
S11G1299 SOMON
S11G1301 ECRU
S11G1302 CREAM

Now usually I use the FIND tool typing, for example, the "Order No" for example "S11G1299" in the Sheet2: and look at the color, let's say "GREEN" and copying the data under S M L XL...etc. from the table in Sheet1 to the same table in Sheet2, and do it over and over again for different Orders and note that the orders in Sheet2 can't resort for different reasons and the orders in Sheet1 have a different sorting system, my question is there any way or VBA code to do such a job? I mean going from Row1 or 2 and making data entry order by order?

I hope you understood me,

Thank you very much already for your help.

Regards.

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, order As Range, fnd As Range, sAddr As String
    Set srcWS = Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
    Set desWS = Sheets("[COLOR="#FF0000"]Sheet2[/COLOR]")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each order In srcWS.Range("A2:A" & LastRow)
        Set fnd = desWS.Range("A:A").Find(order, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                If order.Offset(0, 1) = fnd.Offset(0, 1) Then
                    fnd.Offset(0, 2).Resize(, 9).Value = order.Offset(0, 2).Resize(, 9).Value
                End If
                Set fnd = desWS.Range("A:A").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    Next order
    Application.ScreenUpdating = True
End Sub

Change the sheet names (in red) to suit your needs.