Excel VBA循环代码

Question

I need help with loop code to copy one cell from column R and paste into next empty cell in column C.

column C

12345                      
12345                      
12345                      
(paste 1 in here)   
12346   
12346   
(paste 2 in here)   
12347   
12347   
12347   
12347   
(paste 3 in here)   

Column R

1

2

3

I used this code but when I will have 500 records it seems impossible to repeat this code for 500 times.

Range("R2").Select
Selection.Copy
Range("C1").Select

If IsEmpty(ActiveCell.Offset(1, 0)) Then
    ActiveCell.Offset(1, 0).Select
Else
    ActiveCell.End(xlDown).Offset(1, 0).Select
End If

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

Answer 1

Try this:

Option Explicit

Public Sub CopyAndPaste()

    Dim colToPaste  As New Collection
    Dim rngCell     As Range

    With Worksheets(1)
        For Each rngCell In .Range("B1:B5")
            colToPaste.Add rngCell
        Next rngCell

        For Each rngCell In .Range("A1:A500")
            If IsEmpty(rngCell) Then
                If colToPaste.Count = 0 Then Exit Sub
                rngCell = colToPaste(1)
                colToPaste.Remove (1)
            End If
        Next rngCell
    End With

End Sub

In general, this is what we have:

• a collection colToPaste , which contains all the values of the range B1:B5 . You can change the collection range and make it with variable, as per the last row in column B . See here - https://www.rondebruin.nl/win/s9/win005.htm
• A loop going through the range A1:A500, which would check for every cell, whether it is empty or not. If it is empty, it would give it the value of the first one in the list like this - rngCell = colToPaste(1) . Then it would remove it.
• In order to know when to stop, I have added If colToPaste.Count = 0 Then Exit Sub . The =0 part can be removed, but it is easier to understand it this way.