VBA copy paste range if

[JAQ1983]

Hi all, new to VBA so please be gentle.

I have created my first piece of coding and need to amend it slightly but not sure how.

Basically I am wanting to copy data from sheet 1 (Sales) and paste to either sheet 2 (RM DOM) or sheet 3 (RM IND) based on two IF statements.
If column B in sheet "Sales" = "DOM" & column S = "Yes" then: paste to the next free row in sheet "RM DOM"
If column B in sheet "Sales" = "IND" & column S = "Yes" then: paste to the next free row in sheet "RM IND"

There are 2 header rows in each sheet and the data is to be posted from row 3 down.

I have managed to get this to work to copy the entire row, however I need to amend the code to copy and paste a range ("A:AA") so that additional data can be added to columns in the destination sheets.

On top of this I have added a line to remove duplicates based on a unique sales reference number which will be present in column C.

Any help would be appreciated as I have exhausted Google to solve this. TIA

Here's the code I have so far:

Sub CopyVal()


a = Worksheets("Minor Sales").Cells(Rows.Count, 1).End(xlUp).Row


For i = 3 To a


If Worksheets("Minor Sales").Cells(i, 2).Value = "DOM" Then
Worksheets("Minor Sales").Cells(i, 19).Value = "Yes"

Worksheets("Minor Sales").Rows(i).Copy
Worksheets("RM DOM").Activate
b = Worksheets("RM DOM").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("RM DOM").Cells(b + 1, 1).Select
Worksheets("RM DOM").Paste


End If

Application.CutCopyMode = False


Worksheets("RM DOM").Range("A:AS").RemoveDuplicates Columns:=Array(3)


Next


a = Worksheets("Minor Sales").Cells(Rows.Count, 1).End(xlUp).Row


For i = 3 To a


If Worksheets("Minor Sales").Cells(i, 2).Value = "IND" Then
Worksheets("Minor Sales").Cells(i, 19).Value = "Yes"

Worksheets("Minor Sales").Rows(i).Copy
Worksheets("RM IND").Activate
b = Worksheets("RM IND").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("RM IND").Cells(b + 1, 1).Select
Worksheets("RM IND").Paste


End If

Application.CutCopyMode = False


Worksheets("RM IND").Range("A:AS").RemoveDuplicates Columns:=Array(3)

Next

End Sub

 

[JackDanIce]

Welcome to the board. Try:

Sub M1()
    
    Dim x           As Long
    Dim LR          As Long
    Dim LC          As Long
    Dim msg         As String
    Dim arr()       As Variant
    Dim w           As Worksheet
    
    Application.ScreenUpdating = False
    
    With w(1)
        LC = .Range("AA1").Column '27
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        For x = 3 To LR
            msg = LCase$(.Cells(x, 2).Value & .Cells(x, 19).Value)
            If msg = "domyes" Or msg = "indyes" Then
                arr = .Cells(x, 1).Resize(, LC).Value
                Sheets("RM " & .Cells(x, 2).Value).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
                Erase arr
            End If
            msg = vbNullString
        Next x
    End With
    
    Sheets("RM DOM").Range("A:AS").RemoveDuplicates Columns:=Array(3)
    Sheets("RM IND").Range("A:AS").RemoveDuplicates Columns:=Array(3)
    
    Application.ScreenUpdating = True
    
End Sub

 

[JAQ1983]

Thanks JackDanIce. However I seem to receive a number of errors with this code. I have fixed the first by set w = worksheets ("Minor Sales")
The second one I don't understand though:

Run time error 438 - object does not support this property or method
on line:
Sheets("RM " & .Cells(x, 2).Value).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr

Many thanks, Jo

 

[JackDanIce]

Hi Jo,

Apologies, was typing above on a laptop on a train and didn't get a chance to test before posting. Try:

Sub M1()
    
    Dim x           As Long
    Dim LR          As Long
    Dim LC          As Long
    Dim msg         As String
    Dim arr()       As Variant
    Dim w           As Worksheet: Set w = Sheets("Minor Sales")
    
    With w
        LC = .Range("AA1").Column '27
        LR = .Cells(.Rows.Count, 2).End(xlUp).Row
        For x = 3 To LR
            msg = LCase$(.Cells(x, 2).Value & .Cells(x, 19).Value)
            If msg = "domyes" Or msg = "indyes" Then
                arr = .Cells(x, 1).Resize(, LC).Value
                Sheets("RM " & .Cells(x, 2).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, LC).Value = arr
            End If
        Next x
    End With
    
    Sheets("RM DOM").Range("A:AS").RemoveDuplicates Columns:=Array(3)
    Sheets("RM IND").Range("A:AS").RemoveDuplicates Columns:=Array(3)
    
    Set w = Nothing
    msg = vbNullString
    Erase arr
    
End Sub

 

[JAQ1983]

Perfect. Thank you very much JackDanIce. Seems to work like a dream
I'll see if I can do the rest of what I need now.

Thanks, Jo

 

[JackDanIce]

You're welcome and best of luck!