# Copy list of numbers to specific cells



## VikingLink (Jan 6, 2023)

For a project I'm working on, I need to copy a list of pupils to a specific place.

I'd like the VBA to go through the list of pupils from top to bottom, and placing them in the first available place, also respecting the order of that list (Place 1, Place 2, ...). If there is no "v" above the place, that means it isn't available.

Because colums might get deleted via another VBA, I'm naming all the cells where a number might be filled in. These go from _n1 to _n50.  The cells that might contain a "v" are also named, going from _kpID1 to _kpID50.

So for example, C13 should become 4, E13 should become 1, I13 3, C7 5 and G7 2.


----------



## DanteAmor (Jan 6, 2023)

In the code I put some notes for you to adjust to your data.

Try this:


```
Sub copylistofnumbers()
  Dim c As Range
  Dim i As Long, j As Long, n As Long, m As Long
  Dim sCell As String
  
  j = 7                 'Initial row of the list of pupils
  With Sheets("Sheet2") 'sheet name
  
    'column where is the cell range of the list of pupils
    n = .Range("O" & j, .Range("O" & Rows.Count).End(3)).Rows.Count
    
    For i = 1 To 50      'number of cells
      sCell = "_kpID" & i
      Set c = Nothing
      On Error Resume Next: Set c = .Range(sCell): On Error GoTo 0
      
      If Not c Is Nothing Then
        If .Range(sCell).Offset(-1) = "v" Then
          .Range(sCell).Value = .Range("O" & j).Value
          m = m + 1
          If m = n Then Exit For
          j = j + 1
        End If
      End If
    Next
    
  End With
End Sub
```


----------



## VikingLink (Jan 6, 2023)

Works like a charm. Thanks!


----------



## Herakles (Jan 6, 2023)

Try this as well.


```
Public Sub subPupilsPosition()
Dim rng As Range
Dim rngTarget As Range
Dim rngPupils As Range
Dim i As Integer
Dim x As Integer
Dim Ws As Worksheet

    Set Ws = Worksheets("Sheet2")
    
    ' This range may need to be changed as appropriate.
    Set rngPupils = Worksheets("Pupils").Range("O7:O56")
   
   ' All the single cell named cells are used for is to determine the range rngTarget.
   ' You could dispense with these named cells if you hard code the range.
   ' e.g. rngTarget = Range("$C$6:$K$36")
    Set rngTarget = Range(Range("_kpID1"), Range("_kpID50"))
                 
    For i = rngTarget.Rows.Count To 1 Step -6
          rngTarget.Rows(i).Interior.Color = vbWhite
          For Each rng In rngTarget.Rows(i).Cells
                rng.Offset(1, 0).Value = ""
                If rng.Value = "v" Then
                    x = x + 1
                    rng.Offset(1, 0).Value = rngPupils.Cells(x, 1)
                End If
            Next rng
   Next i
         
End Sub
```


----------



## VikingLink (Jan 6, 2023)

DanteAmor said:


> 'column where is the cell range of the list of pupils n = .Range("O" & j, .Range("O" & Rows.Count).End(3)).Rows.Count



The range with pupils will also be named. Do I need to change anything aside from the "O"? I don't understand what the End(3) does. Can you elaborate?


----------



## DanteAmor (Jan 6, 2023)

VikingLink said:


> The range with pupils will also be named.



*fit the named range in the code*

Try :


```
Sub copylistofnumbers()
  Dim c As Range
  Dim i As Long, j As Long, n As Long, m As Long, col As Long
  Dim sCell As String
  
  With Sheets("Sheet2")   'sheet name
    *With .Range("_pupil") 'fit the named range*
      j = .Cells(1).Row
      col = .Cells(1, 1).Column
      n = .Rows.Count     'fit the named range
    End With
    
    For i = 1 To 50      'number of cells
      sCell = "_kpID" & i
      Set c = Nothing
      On Error Resume Next: Set c = .Range(sCell): On Error GoTo 0
      
      If Not c Is Nothing Then
        If .Range(sCell).Offset(-1) = "v" And .Cells(j, col).Value <> "" Then
          .Range(sCell).Value = .Cells(j, col).Value
          m = m + 1
          If m = n Then Exit For
          j = j + 1
        End If
      End If
    Next
    
  End With
End Sub
```


----------

