Excel VBA-Do直到空白单元格

我正在录制宏，需要一些帮助。我想将“SalesData”工作表G列中的值复制并粘贴到“Results”工作表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 

---

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

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

---

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

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

---

这只是为了好玩/练习另一种方法：

Sub copyFromG()
Dim copyRng As Range, cel As Range
Dim salesWS As Worksheet, resultsWS As Worksheet

Set salesWS = Sheets("SalesData")
Set resultsWS = Sheets("Results")

Set copyRng = salesWS.Range("G2:G" & salesWS.Range("G2").End(xlDown).Row) ' assuming you have a header in G1

For Each cel In copyRng
    resultsWS.Range("A" & 2 + 10 * copyRng.Rows(cel.Row).Row - 30).Value = cel.Value
Next cel

End Sub

---

这只是为了好玩/练习另一种方法：

Sub copyFromG()
Dim copyRng As Range, cel As Range
Dim salesWS As Worksheet, resultsWS As Worksheet

Set salesWS = Sheets("SalesData")
Set resultsWS = Sheets("Results")

Set copyRng = salesWS.Range("G2:G" & salesWS.Range("G2").End(xlDown).Row) ' assuming you have a header in G1

For Each cel In copyRng
    resultsWS.Range("A" & 2 + 10 * copyRng.Rows(cel.Row).Row - 30).Value = cel.Value
Next cel

End Sub

---

这里是相同的事情，但使用范围变量

Sub x()

    Dim src As Range
    Dim dst As Range

    Set dst = Worksheets("Results").Range("a2")   ' point to top cell of destination

    With Worksheets("SalesData")

        For Each src In Range(.Cells(2, "g"), .Cells(.Rows.Count, "g").End(xlUp)) ' loop through used cell range in column G
            dst.Value = src.Value
            Set dst = dst.Offset(10)               ' move destination pointer down 10 rows
        Next src

    End With

End Sub

---

这里是相同的事情，但使用范围变量

Sub x()

    Dim src As Range
    Dim dst As Range

    Set dst = Worksheets("Results").Range("a2")   ' point to top cell of destination

    With Worksheets("SalesData")

        For Each src In Range(.Cells(2, "g"), .Cells(.Rows.Count, "g").End(xlUp)) ' loop through used cell range in column G
            dst.Value = src.Value
            Set dst = dst.Offset(10)               ' move destination pointer down 10 rows
        Next src

    End With

End Sub

---

G2中的数据到A12，G3中的数据到A22下面的10行，依此类推？是的，没错。停下你正在做的事，看着。你应该看整个系列，但那个视频是必须看的。谢谢你，托马斯！我现在要看。所以G2中的数据到A12，G3中的数据到下面10行到A22，依此类推？是的，没错。停下你正在做的事，看着。你应该看整个系列，但那个视频是必须看的。谢谢你，托马斯！我现在就要看了。打败我吧，因为我花了时间来澄清用户到底想要什么：）@ScottHoltzman我只想留下我的第一印象，如果我错了就删除它。@ScottCraner-记住，你永远不会有第二次机会留下第一印象！：）。。。（除非你这么做）伟大的苏格兰人我也吃了它，因为我花了时间来澄清用户想要什么：）@ScottHoltzman我只是按照我的第一印象，如果我错了就删除。@ScottCraner-记住，你永远不会有第二次机会留下第一印象！：）。。。（除非你这么做）伟大的苏格兰人D