循环和复制/粘贴行 VBA答案

【问题标题】：Looping through and Copying/Pasting rows VBA循环和复制/粘贴行 VBA
【发布时间】：2018-07-28 10:37:32
【问题描述】：

我希望在 xl VBA 中编写一个简单的宏，该宏循环遍历单元格 A1:A100 和；

查找值为“HT”的每个单元格
复制整行
选择工作表“记录” - 移动到 A 列的底部 - 粘贴复制的行
循环

这是我的尝试 - 我正在努力让它发挥作用，并且一直在谷歌上搜索各种不同的方法，但似乎无法奏效！

私有子 CopyRow()

Dim i As Range
Sheets("Input").Select
Range("A1").Select

For Each i In Sheet9.Range("A2:A1000")
    Select Case i.Value
        Case "HT"
            Rows(ActiveCell.Row).Copy
            Sheets("Records").Select
            Range("A2").End(xlDown).PasteSpecial xlPasteValues
            Sheets("Input").Select

            Case Else

        End Select

    Next i

感谢您能给我的任何帮助！

【问题讨论】：

我没有答案，但请看一下我在这里使用的避免使用“选择”的方法：stackoverflow.com/a/40768023/4961700

标签： excel vba

【解决方案1】：

我认为数据在“输入”工作表中，结果必须进入“记录”工作表。从你的解释我不知道“Sheet9”工作表的意义是什么。

这是一段快速完成你想要的代码：

Sub copy_HT_rows()

    Dim rng As Range
    Sheets("Input").Select
    Range("A1").Select

    For Each rng In Sheets("input").Range("A1:A100")
        If rng.Value = "HT" Then
            Rows(rng.Row).Copy
            Sheets("Records").Select
            If (Range("A1") <> "") Then
                Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                Range("A1").PasteSpecial xlPasteValues
            End If
            Sheets("Input").Select
        End If
    Next rng
End Sub

【讨论】：

【解决方案2】：

使用自动过滤器

Option Explicit
Public Sub test()
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets("Sheet9").Range("A1:A1000") '<include header
    If Application.WorksheetFunction.CountIf(rng, "HT") = 0 Then Exit Sub
    rng.AutoFilter
    rng.AutoFilter 1, "HT"

    With ThisWorkbook.Worksheets("Records")
          rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
    End With
    rng.AutoFilter
End Sub

【讨论】：

【解决方案3】：

您的问题在于“ActiveCell.Row”，正如我想您所假设的那样，活动单元格不是循环当前单元格，即“i”，因此您可以改用“i.Row”

但您也可以避免所有选择/激活并使用完全限定的范围引用：

Private Sub CopyRow()

    Dim i As Range

    With Sheets("Records") ‘reference target sheet
        For Each i In Sheet9.Range("A2:A1000") ‘loop through Sheet9 "A2:A1000" cells
            If i.Value2 = "HT" Then
                i.EntireRow.Copy
                .Cells(.Rows.Count,"A").End(xlUp).Offset(1,0).PasteSpecial xlPasteValues ‘ all “dots” are making following members/object referencing the object referenced in “With...” 
            End If
        Next
    End With
End Sub

【讨论】：