help with vba copy from one worksheet and paste in another

kevinh2320

Board Regular
Joined
May 13, 2016
Messages
55
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!
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,698
Office Version
2019
Platform
Windows
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
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
12,920
Office Version
365, 2010
Platform
Windows, Mobile
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:

Watch MrExcel Video

Forum statistics

Threads
1,102,907
Messages
5,489,644
Members
407,703
Latest member
Chibuzo

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top