循环查找值并将某些三个单元格复制到另一个工作表

Question

我是 VBA 新手，并且对我的代码不工作有疑问。 首先，长篇大论总结... 我已将单元格 A2 中的数据粘贴到 F（未确定行）。第 1 行是未更改的标题。粘贴数据后，宏选择单元格 G2 和 H2 并将它们复制到粘贴数据的末尾。单元格 G2 和 H2 中包含 IF 公式...如果条件为假，则将单元格留空。

这就是我的宏代码发挥作用的地方。

下面的代码循环遍历列 G 以查找值（非空白）并将单元格 G、C 和 E 复制到另一个工作表并分别粘贴到单元格 D、B、abd C 中。 该代码适用于第一行数据，但似乎没有循环 G 列的其余部分。 非常感谢任何帮助以使其正常工作。

由于这是我第一次在任何帮助网站上发帖，请原谅这篇帖子的任何违反规则，并请让我知道我做错了什么，这样我就不会再犯了。谢谢

Sub XFerData()

    Dim RowGCnt As Long, CShtRow As Long

    Dim CellG As Range

    RowGCnt = 2
    CShtRow = 4

    Set CellG = Range("G2:G" & RowGCnt)

    For Each Cell In CellG.Cells
        If Range("G" & RowGCnt).Value <> "" Then
            Worksheets("Plate Kit-Frame").Range("G" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("D" & CShtRow).PasteSpecial xlPasteValues
            Worksheets("Plate Kit-Frame").Range("C" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("B" & CShtRow).PasteSpecial xlPasteValues
            Worksheets("Plate Kit-Frame").Range("E" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("C" & CShtRow).PasteSpecial xlPasteValues
        CShtRow = CShtRow + 1
        RowGCnt = RowGCnt + 1
        End If
    Next
End Sub

Answer 1

Sub XFerData()

    Dim RowGCnt As Long, CShtRow As Long
    Dim LastRow As Long
    Dim CellG As Range

    CShtRow = 4
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    For RowGCnt = 2 to LastRow
        If Range("G" & RowGCnt).Value <> "" Then
            Worksheets("Plate Kit-Frame").Range("G" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("D" & CShtRow).PasteSpecial xlPasteValues
            Worksheets("Plate Kit-Frame").Range("C" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("B" & CShtRow).PasteSpecial xlPasteValues
            Worksheets("Plate Kit-Frame").Range("E" & RowGCnt).Copy
            Worksheets("Cutting Sheet").Range("C" & CShtRow).PasteSpecial xlPasteValues
        CShtRow = CShtRow + 1
        End If
    Next RowGCnt
End Sub