I am new to VBA and I'm trying to automate a reporting function on a spreadsheet which requires manual work that could be avoided. I have created the below code but I keep on receiving error messages. I will explain what I am trying to achieve and hopefully we will find a solution to this issue.
I have two sheets, and I want to look into column L of Sheet1 and for all cells that has "NO" for value, I want to copy the value in column A of the same row, and paste it in the last row of Sheet2 in the column A.
Sounds pretty simple but I cannot get my head around the code.
What is wrong with the below code?
Sub SearchMacro()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Sheets("Sheet1")
wb.Activate
ws.Select
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 1 To RowCount
Range("L" & i).Select
If ActiveCell = "NO" Then
ActiveCell.Range("A").Copy
Sheets("Sheet2").Select
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & RowCount + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next
End Sub
I think you can use autofilter instead of looping.
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Cells.AutoFilter ' set an filter on the sheet
With Sheets("Sheet1").Range("A1:L" & RowCount) ' filter on NO column L
.AutoFilter Field:=12, Criteria1:="NO"
End With
Sheets("Sheet1").Range("A2:L" & Range("A2").End(xlDown)).Copy 'Copy the filtered data
Sheets("Sheet2").Select
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & RowCount + 1).Select
ActiveSheet.Paste
I'm kind of tempted to flag this question as duplicate, because there's tons of these copy-paste data questions on daily basis, but oh well..
Don't use Select/ActiveCell/Activesheet/Activeworkbook/..
period!! It's a bad vba-excel
practice that can always be avoided. Also, Just because your loop through RowCount doesn't mean the cell is active. This is probably also the reason why you keep getting errors: Application.ActiveCell
under MSDN definition is as follows:
Returns a Range object that represents the active cell in the active window (the window on top) or in the specified window. If the window isn't displaying a worksheet, this property fails . Read-only.
(for more info on how to avoid using these refer to this stackoverflow question)
There are some small errors in your code altogether. I don't have the data you are working with, nor info on which sheet is which, so I'll just go with presumption Sheet1 contains data you want to copy and Sheet2 where you want to paste it
Private Sub copy_paste() Dim ws_source As Worksheet: Set ws_source = Sheets("Sheet1") Dim ws_target As Worksheet: Set ws_target = Sheets("Sheet2") Dim last_row As Long last_row = ws_source.Cells(ws_source.Rows.Count, "L").End(xlUp).Row Dim next_paste As Long For i = 1 To last_row If ws_source.Cells(i, "L") = "NO" Then ws_source.Rows(i).EntireRow.Copy next_paste = ws_target.Cells(ws_target.Rows.Count, "A").End(xlUp).Row + 1 ws_target.Rows(next_paste).PasteSpecial xlPasteValues End If Next i End Sub
You could use FIND
. This will find NO but not No or nO (change to MatchCase=False
to find all cases).
Public Sub SearchAndCopy()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim last_row As Long
Dim rFound As Range
Dim sFirstAdd As String
Set wb = ThisWorkbook 'ActiveWorkbook
'Workbooks("SomeWorkbook.xlsx")
'Workbooks.Open("SomePath/SomeWorkbook.xlsx")
Set ws = wb.Worksheets("Sheet1")
Set ws1 = wb.Worksheets("Sheet2")
With ws.Columns("L")
Set rFound = .Find(What:="NO", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rFound Is Nothing Then
sFirstAdd = rFound.Address
Do
'Find next empty row on destination sheet.
'Only really need to give worksheet reference when
'counting rows if you have 2003 & 2007+ files open - "ws.Rows.Count"
last_row = ws1.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
'Copy the figure from source to target sheet.
'You could also use Copy/Paste if you want the formatting as well.
ws1.Cells(last_row, 1) = ws.Cells(rFound.Row, 1)
'Look for the next matching value in column L.
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAdd
End If
End With
End Sub
I've added an explanation of your code below - the main thing wrong with your code is ActiveCell.Range("A").Copy
. There is no range A
, but there is A1
, A2
, etc.
Sub SearchMacro()
'You didn't declare these two which
'indicates you haven't got Option Explicit
'at the top of your module.
Dim RowCount As Long
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
'I'll only comment that you set
'wb to be the ActiveWorkbook and you then
'activate the active workbook which is already active.....
Set wb = ActiveWorkbook
Set ws = Sheets("Sheet1")
wb.Activate
ws.Select
'Looks at the active sheet as you just activated it.
'Generally better to say "the cells in this named worksheet, even if it isn't active, or
'in the active book... just reference the damn thing."
'Something like "ws.cells(ws.cells.rows.count,"A").End(xlUp).Row"
'Note it references the correct worksheet each time.
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 1 To RowCount
Range("L" & i).Select
If ActiveCell = "NO" Then
'Your code falls over here - you can't have range A.
'You can have range A1, which is the first cell in your referenced range.
'So ActiveCell.Range("A1") will return the ActiveCell - "L1" probably.
ActiveCell.Range("A1").Copy
'This will copy from column A using your method:
'ws.Cells(ActiveCell.Row, 1).Copy
'If you get the above line correct this will all work.
Sheets("Sheet2").Select
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & RowCount + 1).Select
ActiveSheet.Paste
'You've already called it "ws" so just "ws.Select" will work.
Sheets("Sheet1").Select
End If
Next
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.