help with vba copy from one worksheet and paste in another

kevinh2320

Board Regular
Joined
May 13, 2016
Messages
61
I'm trying to learn VBA but, haven't been able to get my code to work. I have a worksheet called Leases. In column "F" of this worksheet I have a dropdown menu with "Yes" & "Question" as the options. I want to copy the entire row (cells A - J) if cell "F" contains either of those options. Then paste that data into the next available row in my "Notes" worksheet.

Below is my incomplete code:

Sub Test()


Dim rngFound As Range
With Worksheets("Leases").Cells
Set rngFound = .Find("Yes", LookIn:=xlValues)
If Not rngFound Is Nothing Then
Worksheets("Notes").Activate
Range("A1048576").Select
Selection.End(xlUp).Offset(1, 0).PasteSpecial
Else
'nothing found
End If
End With


End Sub

Appreciate your help!
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Try this code instead

Code:
Option Explicit


Sub kevinh()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Leases")
    Set s2 = Sheets("Notes")
    Dim i As Long, lr As Long, lr2 As Long
    lr = s1.Range("F" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To lr
        If s1.Range("F" & i) = "Yes" Or s2.Range("F" & i) = "Question" Then
            lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
            s1.Range("A" & i & ":J" & i).Copy
            s2.Range("A" & lr2).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Action Completed!"
End Sub
 
Upvote 0
Personally I'd use the autofilter rather than loop the code i.e.

Code:
Sub Filterit()
    Application.ScreenUpdating = False
    With Sheets("Leases").Range("A1:J" & Sheets("Leases").Range("F" & Rows.Count).End(xlUp).Row)
        .AutoFilter 6, "Yes", xlOr, "Question"
        
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy _
        Sheets("Notes").Range("A" & Rows.Count).End(xlUp).Offset(1)
        On Error GoTo 0
        .AutoFilter
    
    End With
    Application.ScreenUpdating = True
End Sub

Please note that Row 1 in the Leases sheet must be a header row.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,920
Messages
6,122,262
Members
449,075
Latest member
staticfluids

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top