Question

我是VBA的新手，对我的代码无法解决问题。首先，长篇小说总结...... 我已将数据粘贴到单元格A2到F（Undetermind Row）中。第1行是不更改的标题。粘贴数据后，宏选择单元格G2和H2并将其复制到粘贴数据的末尾。细胞G2和H2中含有IF公式......如果标准为假，则将细胞留空。

这是我的宏代码发挥作用的地方。

下面的代码循环遍历G列，查找值（非空白）并将Cell 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

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

1 个答案: