vba - Excel VBA - 直到空白单元格

Question

我正在录制宏，需要一些帮助。我想将“SalesData”工作表的 G 列中的值复制并粘贴到“结果”工作表的单元格 A2、A12、A22 等中，直到 G 列中没有更多值。

VBA 对我来说很新，我尝试过使用 Do/Until，但一切都崩溃了。请你帮助我好吗？请参阅我在下面记录的代码。谢谢!

Sub(x)

 Sheets("SalesData").Select
    Range("G2").Select
    Selection.Copy
    Sheets("Results").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("A12").Select
    Sheets("SalesData").Select
    Range("G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Results").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("A22").Select
        Sheets("SalesData").Select
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Results").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        Range("A32").Select
        Sheets("SalesData").Select
    Range("G5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Results").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub 

Answer 1

我更喜欢先找到列中的最后一个单元格，然后使用 For环形。

由于您只做值，我们可以避免使用剪贴板并直接分配值。

由于您每 10 个单元格粘贴一次，因此我们可以使用单独的计数器在每个循环中向下移动 10 个。

Sub x()
Dim ws As Worksheet
Dim lst As Long
Dim i As Long, j As Long
'use variable to limit the number of times we type the same thing
Set ws = Worksheets("Results")
'First row of the output
j = 2
'using with and the "." in front of those items that belong to it also limits the typing.
With Worksheets("SalesData")
    'Find the last row with values in Column G
    lst = .Cells(.Rows.Count, 7).End(xlUp).Row
    'Loop from the second row to the last row.
    For i = 2 To lst
        'Assign the value
        ws.Cells(j, 1).Value = .Cells(i, 7).Value
        'Move down 10 rows on the output
        j = j + 10
    Next i
End With

End Sub