Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

maro to copy and paste from one worksheet to another based on a condition

Posted on 2016-10-17
11
Medium Priority
?
90 Views
Last Modified: 2016-10-18
Hi Expert Team,

I need a macro that will copy  range C6:C200 from "master" sheet and paste onto  B21 in the "quotesheet" sheet but only if there is a value "yes" in range D6:D200. below is what I have so far and it works but I need it to only copy paste if there is a value "yes" in D6:D200 in the "master" sheet. I created a bottom called "import items" that runs the macro. Also attached is a sample file. In advance your help is greatly appreciated


Sub copyover()

    Sheets("master").Select
    Range("C6:C200").Select
    Selection.Copy
    Sheets("QouteSheet").Select
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


End Sub
0
Comment
Question by:Braulio cordova
  • 4
  • 3
  • 3
  • +1
11 Comments
 
LVL 54

Expert Comment

by:Ryan Chong
ID: 41847640
try use: WorksheetFunction.CountIf in your macro codes, like:

Sub copyover()

    Sheets("master").Select

If WorksheetFunction.CountIf(Range("D6:D200"), "yes") >= 1 Then

    Range("C6:C200").Select
    Selection.Copy
    Sheets("QouteSheet").Select
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

end if 

End Sub 

Open in new window

0
 
LVL 35

Expert Comment

by:Norie
ID: 41847722
Perhaps.
Sub copyover()

    With Sheets("master")
        If ApplicationCountIf(.Range("D6:D200"), "Yes") > 0 Then
            .Range("C6:C200").Copy
            Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues
        End If  
    End With 

End Sub

Open in new window

0
 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 41847770
Hi,

pls try
Sub CopyOver()
    Sheets("master").Activate
    Set Rng = Nothing
    For Each c In Range("C6:C200")
        If LCase(c.Offset(, 1)) = "yes" Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(c, Rng)
            End If
        End If
    Next
    Rng.Copy
    Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Open in new window

Regards
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Braulio cordova
ID: 41848184
Hi Rgonzo1971,

I am getting a run-time erro "9": subscript out of range. the code is stopping at this point......
 Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues

Any Thoughts?

Thanks
Braulio
0
 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 41848191
How is QuoteSheet written
QuoteSheet or QouteSheet
Could you send a dummy?
0
 

Author Comment

by:Braulio cordova
ID: 41848357
Hi Rgonzo1971,

Yes indeed I had it misspelled. The code works perfectly. One last question, can you please add a piece of code that after the macro finishes the copy and paste  it sets  focus on the "quotesheet"  and not the "master" sheet?

Thanks
Braulio
0
 
LVL 35

Expert Comment

by:Norie
ID: 41848481
If you want focus to stay on the 'master' sheet try this.
Sub CopyOver()
Dim rng As Range
Dim c As Range

    With Sheets("master")

        For Each c In .Range("D6:D200")
            If LCase(c) = "yes" Then
                If rng Is Nothing Then
                    Set rng = .Offset(, -1)
                Else
                    Set rng = Union(.Offset(, -1), rng)
                End If
            End If
        Next

    End With

    If Not rng Is Nothing Then
        rng.Copy
        Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    
End Sub

Open in new window

0
 
LVL 53

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 41848525
HI,

pls try
Sub CopyOver()
    Sheets("master").Activate
    Set Rng = Nothing
    For Each c In Range("C6:C200")
        If LCase(c.Offset(, 1)) = "yes" Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(c, Rng)
            End If
        End If
    Next
    Rng.Copy
    Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Sheets("QuoteSheet").Activate
End Sub

Open in new window

0
 

Author Comment

by:Braulio cordova
ID: 41848529
Hi Norie,

I want the focus to stay on quotesheet not master. I tried the code and I got the following error

run-time error '438": "the object doesn't support this property or method.

Thank you in advance for the support
0
 

Author Closing Comment

by:Braulio cordova
ID: 41848554
Thank you Rgonzo1971!

This is exactly while I need it.

Braulio
0
 
LVL 35

Expert Comment

by:Norie
ID: 41848730
The code I posted will keep focus on whatever sheet was active when the code is run.

It also won't switch between sheets when running.:)

Anyway, here it is with the typos that caused the error(s) fixed.
Sub CopyOver()
Dim rng As Range
Dim c As Range

    With Sheets("master")

        For Each c In .Range("D6:D200")
            If LCase(c) = "yes" Then
                If rng Is Nothing Then
                    Set rng = c.Offset(, -1)
                Else
                    Set rng = Union(c.Offset(, -1), rng)
                End If
            End If
        Next

    End With

    If Not rng Is Nothing Then
        rng.Copy
        Sheets("QuoteSheet").Range("B21").PasteSpecial Paste:=xlPasteValues

    End If

    Application.CutCopyMode = False    

End Sub

Open in new window

0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

783 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question