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

我是新来的VBA，并有一个关于我的代码不起作用的问题。 首先，总结长篇故事…我已经把数据粘贴到单元格A2到F（Undetermind Row）中。 第1行是一个不改变的标题。 数据粘贴后，macrosselect单元格G2和H2，并将其复制到粘贴数据的末尾。 单元格G2和H2在它们中有IF公式…如果条件为假，则将单元格留空。

这里是我的macros代码进场的地方。

下面的代码循环遍历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