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

Question

Я новичок в VBA и задаю вопрос о том, что мой код не работает. Во-первых, длинный рассказ ... Я вставил данные в ячейки от A2 до F (Undetermind Row). Строка 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