Цикл поиска значений и копирование определенных трех ячеек в другой лист

Question

Я новичок в VBA и у меня есть вопрос о моем коде, который не работает. Во-первых, подведем итог длинной истории... Я вставил данные в ячейки A2 в F(Undetermind Row). Строка 1 - это заголовок, который не изменился. После вставки данных макрос выбирает ячейки G2 и H2 и копирует их до конца вставленных данных. Ячейки G2 и H2 содержат формулы IF... если критерий ложен, оставьте ячейку пустой.

Вот где мой макрос код вступает в игру.

Приведенный ниже код перебирает столбец G в поисках значений (без пробелов) и копирует ячейки G, C и E на другой лист и вставляет их в ячейки D, B и ab соответственно. Код работает для первой строки данных, но, похоже, не зацикливается на остальной части столбца 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