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

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
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,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

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