创建循环,复制给定特定单元格值的某些单元格

时间:2015-09-21 17:07:11

标签: excel vba excel-vba loops

您好我已经厌倦了创建一个循环来复制整行并将其粘贴到另一个工作表中,这取决于两件事。

首先,有一个完成级别列,如果值不等于100%那么它们应该被复制,我也只想复制非空白的行。

将行复制到下一个工作表中后,我希望运行B列,每次更改值时都应插入一个新的空行。

我不确定你是否可以这种方式使用这种循环,任何输入都会非常感激。

return $(this).data('waypoint-offset');

1 个答案:

答案 0 :(得分:0)

首先,行For Each c In Range("H:B")将循环遍历B-H列中的每个单元格。这真的是你想要的吗?我不这么认为。这需要你的代码永远循环通过!它还会检查每个细胞的条件!

尝试下面粘贴的代码。它使用AutoFilter更快,更可靠,以及复制和粘贴数据的SpecialCells方法。

插入行时,需要从最后一行向后退一步。这是因为当Excel插入行时,它将通过原始计数器关闭。

Sub FilterCopy()

Dim wT As Worksheet, wPO As Worksheet

Set wT = Sheets("Tracker")
Set wPO = Sheets("Project Overview")

With wT

    Dim lRow As Long
    lRow = .Range("B" & .Rows.Count).End(xlUp).Row

    With .Range("B1:H" & lRow)
        .AutoFilter 7, "<>100%" '7th column not 100% (column H)
        .AutoFilter 1, "<>" '1st column not blank (column B)
    End With

    Intersect(.UsedRange,.UsedRange.Offset(1), .Range("B1").EntireColumn).SpecialCells(xlCellTypeVisible).EntireRow.Copy

End With

With wPO

    .Range("A24").PasteSpecial xlPasteValues

    lRow = .Range(.Range("B24"), .Range("B" & .Rows.Count).End(xlUp)).Rows

    Dim i As Integer
    For i = lRow To 24 Step -1

        If .Range("B" & i) <> "" Then .Range("B" & i).Insert Shift:=xlDown

    Next

End With

End Sub