我需要遍历一列,如果满足条件,则将单元格从一张纸复制到另一张纸。
我正在查找增量文件的问题。 在这种情况下,结果翻倍。
先谢谢您。 KR
Sub copycell()
Dim iLastRow As Long
Dim i As Long
Dim erow As Long
erow = 1
iLastRow = Worksheets("Clientes").Cells(Rows.Count, "C").End(xlUp).Row
For i = 13 To iLastRow
If Sheets("Clientes").Cells(i, 3) = "0" Then
Worksheets("Ficheros").Range("B" & erow).End(xlUp).Offset(1) = Sheets("Clientes").Cells(i, 4)
erow = erow + 1
End If
Next i
End Sub
答案 0 :(得分:0)
您可以使用AutoFilter
来获得结果,但是我的答案是尝试使用For
循环来解析代码。
修改后的代码
Option Explicit
Sub copycell()
Dim iLastRow As Long
Dim i As Long
Dim erow As Long
' get first empty row in column B in "Ficheros" sheet
erow = Worksheets("Ficheros").Range("B" & Rows.Count).End(xlUp).Row + 1
With Worksheets("Clientes")
iLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 13 To iLastRow
If .Cells(i, 3) = "0" Then
Worksheets("Ficheros").Range("B" & erow) = .Cells(i, 4)
erow = erow + 1
End If
Next i
End With
End Sub
答案 1 :(得分:0)
为什么不使用自动过滤器过滤C列,并且如果自动过滤器返回任何行,请将其复制到目标工作表?
看看这样的事情是否对您有用...
Sub CopyCells()
Dim wsData As Worksheet, WsDest As Worksheet
Dim iLastRow As Long
Application.ScreenUpdating = False
Set wsData = Worksheets("Clientes")
Set WsDest = Worksheets("Ficheros")
iLastRow = wsData.Cells(Rows.Count, "C").End(xlUp).Row
wsData.AutoFilterMode = False
With wsData.Rows(12)
.AutoFilter field:=3, Criteria1:="0"
If wsData.Range("D12:D" & iLastRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("D13:D" & iLastRow).SpecialCells(xlCellTypeVisible).Copy
WsDest.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
End If
End With
wsData.AutoFilterMode = False
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub