简体   繁体   中英

Copy data from one sheet to another with the cell value

I have a sheet "Data". With this sheet, I am looking into the column K. If it is red in colour then I am extract the complete row and copy them to another sheet " Delay".

I am following the below code. The code does not have any error but, It just copies 4 rows of red while I have 12 rows.

Could anyone help me to find where I am wrong and what changes I need?

Sub delay()
Dim cell As Range
Dim nextrow As Long
Dim a As Double

Application.ScreenUpdating = False
a = Application.WorksheetFunction.CountA(Sheets("Data").Range("K:K"))
For Each cell In Sheets("Data").Range("K5:K" & a)
If cell.DisplayFormat.Interior.Color = vbRed Then
nextrow = Application.WorksheetFunction.CountA(Sheets("Delayed").Range("K:K"))
Rows(cell.Row).Copy Destination:=Sheets("Delayed").Range("A" & nextrow + 1)
End If

Next
Application.ScreenUpdating = False
End Sub

First of all:
WorksheetFunction.CountA counts the number of cells that are not empty and the values within the list of arguments, you can't use it to count the total number of rows or to find number of the last row (unless all cells are not empty).
What you might need is:

nmbRows = Workbook("WorkbookName").Worksheet("SheetName").Range("K" & Rows.Count).End(xlUp).Row

or something less blunt.
Using CountA can result in constriction of your range of search which will lead in data loss or, in your case, inserting a row in incorrect place.
Example:
Result of

Option Explicit
Sub test()
    Dim a As Long
    a = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Ëèñò1").Range("A:A"))
    ThisWorkbook.Sheets("Ëèñò1").Range("B1").Value = a
End Sub

is
在此处输入图片说明
Second:
Be cautious, add a reference to each range , sheet as

ThisWorkbook.Sheets("Data").Range("K5:K" & nmbRows)

By doing this you can always be certain you're refering to correct range you want to check.

Another note:
I'm not VBA expert but if I were you I would count number of rows for each sheet respectively at the start of the macro, in loop I would use nextrow=nextrow + 1 construction instead of calling function each time.

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM