Macro to copy data from one sheet and paste to another based on cell contents

[fujiman]

I have two sheets set up, they are named "Quotes" and "Sales Orders" and the information I want to start copying from the "Quotes" and pasting to the "Sales Orders". The data starts in the range of A3 - O3. I would like to have the sheet automatically copy that entire range if the contents of the O cells reads "Yes" while also maintaining its current formatting after its pastes to the "Sales Orders" sheet. Is this a possible function and can it scan every row in the sheet to copy all of the rows that meet the criteria? And have I provided enough information?
Thank you

 

[MrKowz]

Welcome to the forums!

If I understand correctly, you want the code to go through column O on the "Quotes" sheet and when it finds a "Yes" value to copy across columns A:O on that row into the sheet "Sales Orders". Where in the "Sales Orders" sheets would this be pasted? Would it be in columns A:O on the first blank row?

 

[fujiman]

Welcome to the forums!

If I understand correctly, you want the code to go through column O on the "Quotes" sheet and when it finds a "Yes" value to copy across columns A:O on that row into the sheet "Sales Orders". Where in the "Sales Orders" sheets would this be pasted? Would it be in columns A:O on the first blank row?

Yes sir that is exactly what I am looking for. Copying form "Quotes" into "Sales Orders". A:O would be pasted to "Sales order" occupying the same range of cells. This would begin at A2:O2 underneath a heading. Apologies if it was not clear in my post.

 

[MrKowz]

Give this a shot - it is untested, so be sure to back up your file first.

Public Sub Fujiman()
Dim sWS     As Worksheet, _
    dWS     As Worksheet
    
Dim rng     As Range, _
    rng1    As Range
    
Dim rowx    As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set sWS = Sheets("Quotes")
Set dWS = Sheets("Sales Orders")

rowx = 2

With sWS.Range("O:O")
    Set rng = .Find("Yes", LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        rng1 = rng.Address
        Do
            sWS.Range(sWS.Cells(rng.Row, "A"), sWS.Cells(rng.Row, "O")).Copy
            With dWS.Range("A" & rowx)
                .PasteSpecial xlPasteValuesAndNumberFormats
                .PasteSpecial xlPasteFormats
            End With
            rowx = rowx + 1
            Set rng = .FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> rng1
    End If
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[fujiman]

The macro successfully selects the test row I set up with "Yes" but it runs into an issue with the starting with "rng1 = rng.Address" and "Loop While Not rng Is Nothing And rng.Address <>rng1" The error popping up is "Run-time error '91': Object variable or With block variable not set"

 

[fujiman]

The macro successfully selects the test row I set up with "Yes" but it runs into an issue with the starting with "rng1 = rng.Address" and "Loop While Not rng Is Nothing And rng.Address <>rng1" The error popping up is "Run-time error '91': Object variable or With block variable not set".

 

[MrKowz]

Whoops - I was typing too fast and dimmed rng1 as a range instead of a string.

Try:

Public Sub Fujiman()
Dim sWS     As Worksheet, _
    dWS     As Worksheet
    
Dim rng     As Range, _
    rng1    As [B][COLOR="#FF0000"]String[/COLOR][/B]
    
Dim rowx    As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set sWS = Sheets("Quotes")
Set dWS = Sheets("Sales Orders")

rowx = 2

With sWS.Range("O:O")
    Set rng = .Find("Yes", LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        rng1 = rng.Address
        Do
            sWS.Range(sWS.Cells(rng.Row, "A"), sWS.Cells(rng.Row, "O")).Copy
            With dWS.Range("A" & rowx)
                .PasteSpecial xlPasteValuesAndNumberFormats
                .PasteSpecial xlPasteFormats
            End With
            rowx = rowx + 1
            Set rng = .FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> rng1
    End If
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[fujiman]

The code is working perfectly and is copying and pasting the data along with its formatting which is great. However, it stops doing so after A4:O4 in "Quotes" and seems to just highlight A3:O3 in "Sales Orders" from then on.

 

[MrKowz]

Are there values in column O after row 4 which equal "Yes"? I just ran the code on some dummy data, and it functioned as intended.

 

[fujiman]

Yes I have populated cells past row 4 and have been unable to copy them over.