Copy range to other sheet depending on entry in cell

[RutgerdV]

Hello,

I recently discovered VBA.
I want to write values froms cells C4:C10 to another sheet, depending on the number given in C2.
On the first worksheet (ws1)

Number:	2
Value1	7
Value2	6
Value3	5
Value4	4
Value5	3
Value6	2
Value7	1

<tbody>
</tbody>

On the next worksheet (ws2), I have number 1 to 10. If the number in the first row is the same as given in C2, then the values (C4:10) need to be copied in the cells below that number.

1 2 3 4 5 6 7 8 9 10 Value1 7 Value2 6 Value3 5 Value4 4 Value5 3 Value6 2 Value7 1 <tbody> </tbody>

<tbody>
</tbody>

I already got a code to find the the same number:

Private Sub CommandButton1_Click()
Dim FindString As String
Dim Rng As Range
FindString = Sheets("ws1").Range("c2").Value
If Trim(FindString) <> "" Then
With Sheets("ws2").Range("B1:K1")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub

Many thanks!

 

[JackDanIce]

Welcome to the board. Try:

Private Sub CommandButton1_Click()

    Dim str     As String
    Dim arr()   As Variant

    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    
    Set ws1 = Sheets("ws1")
    Set ws2 = Sheets("ws2")
    
    Dim rng     As Range
    
    With ws1
        str = Trim$(.Range("C2").value)
        arr = .Range("C4:C10").value
    End With
    
    Application.ScreenUpdating = False
    
    If LenB(str) > 0 Then
        With ws2.Cells(1, 2).Resize(, 10)
            Set rng = .find(str, .Cells(.Cells.count), xlValues, xlWhole)
            If Not rng Is Nothing Then rng.Offset(1).Resize(UBound(arr, 1)).value = arr
        End With
    End If
    
    Application.ScreenUpdating = True
    
    Set rng = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
    Erase arr
    
End Sub