Copy range to other sheet depending on entry in cell

RutgerdV

New Member
Joined
Mar 17, 2016
Messages
1
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
Value17
Value26
Value35
Value44
Value53
Value62
Value71

<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.
12345678910
Value17
Value26
Value35
Value44
Value53
Value62
Value71

<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!
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,701
Office Version
  1. 365
Platform
  1. Windows
Welcome to the board. Try:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,312
Messages
5,600,887
Members
414,414
Latest member
neil_c

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top