循環查找值並將某些三個單元格複製到另一個工作表中

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