【问题标题】:Copy Cell to another sheet in condition is met Loop在满足条件的情况下将单元格复制到另一张工作表循环
【发布时间】:2023-03-28 03:00:01
【问题描述】:

我需要遍历一列,如果满足条件,则将单元格从一张纸复制到另一张纸。

我发现增量的问题.. 在这种情况下,结果翻倍。

提前谢谢你。 韩国

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

【问题讨论】:

  • 您通常不需要循环。使用过滤器,然后复制可见单元格是一步完成的一种方法。
  • 如果erow 代表最后一行,我不确定你是否需要End(xlUp).Offset(1)。

标签: excel vba


【解决方案1】:

为什么不使用自动过滤器过滤列 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

【讨论】:

    【解决方案2】:

    您可以使用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
    

    【讨论】:

      猜你喜欢
      • 2021-04-10
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2022-08-23
      • 1970-01-01
      • 1970-01-01
      • 2018-01-17
      相关资源
      最近更新 更多