Looping to find values and copying certain three cells to another worksheet

822 views Asked by At

I'm new to VBA and have a question about my code that is not working. First, long story summarized... I have pasted data in cells A2 to F(Undetermind Row). Row 1 is a header that does not changed. After the data has been pasted a macro selects cells G2 and H2 and copies them down to the end of the pasted data. Cells G2 and H2 have IF formulas in them...if the criteria is false then leave the cell blank.

Here is where my macro code comes into play.

The code below is looping through column G looking for values (Non-Blanks) and copying Cell G, C, and E to another worksheet and pasting in cell D, B, abd C respectivly. The code works for the first line of data, but doesn't seem to be looping down the rest of column G. Any help would be greatly appreciated to get this working correctly.

And since this is my first post to any help site please excuse any broken rules of this post, and please let me know what I did wrong so I won't do it again. Thanks

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
1

There are 1 answers

1
Chrismas007 On BEST ANSWER
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